Simon Jakobi pushed to branch wip/sjakobi/T27437 at Glasgow Haskell Compiler / GHC

Commits:

• 063edbdb
  by Simon Jakobi at 2026-06-25T15:11:22+02:00

  NCG: thread the liveness fixpoint flag in an unboxed tuple
  
  Replace the hand-written convergence loop with a local 'mapAccumL'' that
  threads the block map and the 'changed' flag together in a single
  unboxed-tuple accumulator, (# Bool, BlockMap Regs #). This keeps the loop
  allocation-free: nothing is boxed per block, matching the previous
  hand-written code while expressing it as a mapAccumL'-style traversal.
  
  The combinator must be local and monomorphic in its accumulator: a
  reusable mapAccumL' would have to thread the two values through one boxed
  accumulator (a strict pair still costs a heap cell per iteration), and a
  representation-polymorphic accumulator that could be an unboxed tuple is
  rejected by GHC's representation-polymorphism restriction. See the new
  Note [Liveness fixpoint convergence test].
  
  Benchmark asm is byte-identical and allocation is unchanged from the
  previous commit (~112 MB less than master on an ~8300-block procedure).
  
  Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
  

• 049f9635
  by Simon Jakobi at 2026-06-26T14:01:44+02:00

  Revert "NCG: thread the liveness fixpoint flag in an unboxed tuple"
  
  This reverts commit 063edbdbfc2b7396024504167801844833ddee4c.
  

• f0b7971f
  by Simon Jakobi at 2026-06-26T14:08:52+02:00

  NCG: rename fixpoint to iterateUntilUnchanged, add type signature
  
  Give the local fixpoint loop a descriptive name and an explicit type
  signature (scoping instr via forall on livenessSCCs).
  
  Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
  

• 912617de
  by Simon Jakobi at 2026-06-26T14:12:13+02:00

  Wibbles
  

• d8a819e7
  by Simon Jakobi at 2026-06-26T14:23:17+02:00

  NCG: fuse the liveness fixpoint change-detection lookup into the insert
  
  The per-SCC liveness fixpoint previously did three map traversals per block
  each iteration: livenessBlock's mapInsert, plus two mapLookups in
  linearLiveness to compare a block's entry before and after the pass -- one of
  which merely re-fetched the value just inserted.
  
  Have livenessBlock do a single mapInsertLookup (a new Label.hs wrapper over
  Word64Map.insertLookupWithKey) that inserts the new entry and returns the old
  one in one traversal, and report whether the entry changed. linearLiveness
  just OR's these per-block flags and no longer touches the map.
  
  Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
  

2 changed files:

• compiler/GHC/Cmm/Dataflow/Label.hs
• compiler/GHC/CmmToAsm/Reg/Liveness.hs

Changes:

     , mapEmpty

     , mapSingleton

     , mapInsert

+    , mapInsertLookup

     , mapInsertWith

     , mapDelete

     , mapAlter

 mapInsert :: Label -> v -> LabelMap v -> LabelMap v

 mapInsert (Label k) v (LM m) = LM (M.insert k v m)

+-- | Insert a value, also returning the value previously bound to the key (if

+-- any). Fuses the insert and lookup into a single traversal of the map.

+mapInsertLookup :: Label -> v -> LabelMap v -> (Maybe v, LabelMap v)

+mapInsertLookup (Label k) v (LM m) =

+  case M.insertLookupWithKey (\_ new _ -> new) k v m of

+    (old, m') -> (old, LM m')

+

 mapInsertWith :: (v -> v -> v) -> Label -> v -> LabelMap v -> LabelMap v

 mapInsertWith f (Label k) v (LM m) = LM (M.insertWith f k v m)

                                         , ppr sccs'])

 livenessSCCs

-       :: Instruction instr

+       :: forall instr. Instruction instr

        => Platform

        -> BlockMap Regs

        -> [SCC (LiveBasicBlock instr)]          -- accum

         = (done, blockmap)

 livenessSCCs platform blockmap done (AcyclicSCC block : sccs)

- = let  (blockmap', block')     = livenessBlock platform blockmap block

+ = let  (_, blockmap', block')  = livenessBlock platform blockmap block

    in   livenessSCCs platform blockmap' (AcyclicSCC block' : done) sccs

 livenessSCCs platform blockmap done

         (CyclicSCC blocks : sccs) =

         livenessSCCs platform blockmap' (CyclicSCC blocks':done) sccs

- where      (blockmap', blocks') = fixpoint blockmap

+ where      (blockmap', blocks') = iterateUntilUnchanged blockmap

             -- Iterate the liveness pass over the SCC until the block map reaches

             -- a fixed point. Only the SCC's own blocks can change between

             -- iterations (livenessBlock only inserts the block it processes, and

             -- earlier SCCs are already finalised).

-            fixpoint bm

-              | changed   = fixpoint bm'

+            iterateUntilUnchanged :: BlockMap Regs -> (BlockMap Regs, [LiveBasicBlock instr])

+            iterateUntilUnchanged bm

+              | changed   = iterateUntilUnchanged bm'

               | otherwise = (bm', blocks'')

               where (changed, bm', blocks'') = linearLiveness bm blocks

+            -- Like @mapAccumL (livenessBlock platform)@, but also OR's together

+            -- the per-block changed flags reported by livenessBlock, so the

+            -- caller can detect the fixed point without comparing block maps.

             linearLiveness

                 :: Instruction instr

                 => BlockMap Regs -> [LiveBasicBlock instr]

                 go !changed bm [] = (changed, bm, [])

                 go !changed bm (block : blks') =

                   case livenessBlock platform bm block of

-                    (bm', block') ->

-                      let bid       = blockId block

-                          !changed' = changed

-                                   || mapLookup bid bm /= mapLookup bid bm'

+                    (blockChanged, bm', block') ->

+                      let !changed' = changed || blockChanged

                       in case go changed' bm' blks' of

                            (changed'', bm'', blks'') ->

                              (changed'', bm'', block' : blks'')

-

 -- | Annotate a basic block with register liveness information.

 --

 livenessBlock

         => Platform

         -> BlockMap Regs

         -> LiveBasicBlock instr

-        -> (BlockMap Regs, LiveBasicBlock instr)

+        -> (Bool, BlockMap Regs, LiveBasicBlock instr)

 livenessBlock platform blockmap (BasicBlock block_id instrs)

  = let

         (regsLiveOnEntry, instrs1)

             = livenessBack platform noRegs blockmap [] (reverse instrs)

-        blockmap'       = mapInsert block_id regsLiveOnEntry blockmap

+        -- Fuse the insert with the lookup of the old entry, so the fixpoint

+        -- loop in livenessSCCs can tell whether this block changed for free,

+        -- without a separate map traversal.

+        (oldEntry, blockmap') = mapInsertLookup block_id regsLiveOnEntry blockmap

+        changed         = oldEntry /= Just regsLiveOnEntry

         instrs2         = livenessForward platform regsLiveOnEntry instrs1

         output          = BasicBlock block_id instrs2

-   in   ( blockmap', output)

+   in   (changed, blockmap', output)

 -- | Calculate liveness going forwards,

 --   filling in when regs are born