GitLab

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

Commits:

94670147

by Simon Jakobi at 2026-06-26T15:01:42+02:00

NCG: avoid boxing the insert-lookup result in livenessBlock

mapInsertLookup's (Maybe v, LabelMap v) pair was allocated and shared because
livenessBlock bound it with a lazy let-pattern and scrutinised it twice. Mark
mapInsertLookup INLINE and consume it with a single case, so the pair cancels
via case-of-known-constructor instead of being allocated.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>

090ac14a

by Simon Jakobi at 2026-06-26T18:28:35+02:00

Revert "NCG: avoid boxing the insert-lookup result in livenessBlock"

This reverts commit 94670147695768dab9a9cdb4c7f40334539e2d36.

3613ce02

by Simon Jakobi at 2026-06-26T18:28:39+02:00

Revert "NCG: fuse the liveness fixpoint change-detection lookup into the insert"

This reverts commit d8a819e71e67f9e372cd92126f2fb63bcdea0419.

2 changed files:

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

Changes:

compiler/GHC/Cmm/Dataflow/Label.hs

@@ -35,7 +35,6 @@ module GHC.Cmm.Dataflow.Label
      , mapEmpty
      , mapSingleton
      , mapInsert
 -    , mapInsertLookup
      , mapInsertWith
      , mapDelete
      , mapAlter
@@ -200,13 +199,6 @@ mapSingleton (Label k) v = LM (M.singleton k v)
  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)

compiler/GHC/CmmToAsm/Reg/Liveness.hs

@@ -891,7 +891,7 @@ livenessSCCs _ blockmap done []
          = (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
@@ -909,9 +909,8 @@ livenessSCCs platform blockmap done
                | 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.
 +            -- Like @mapAccumL (livenessBlock platform)@, but also reports whether
 +            -- any of the SCC's blocks changed.
              linearLiveness
                  :: Instruction instr
                  => BlockMap Regs -> [LiveBasicBlock instr]
@@ -921,8 +920,10 @@ livenessSCCs platform blockmap done
                  go !changed bm [] = (changed, bm, [])
                  go !changed bm (block : blks') =
                    case livenessBlock platform bm block of
 -                    (blockChanged, bm', block') ->
 -                      let !changed' = changed || blockChanged
 +                    (bm', block') ->
 +                      let bid       = blockId block
 +                          !changed' = changed
 +                                   || mapLookup bid bm /= mapLookup bid bm'
                        in case go changed' bm' blks' of
                             (changed'', bm'', blks'') ->
                               (changed'', bm'', block' : blks'')
@@ -935,23 +936,19 @@ livenessBlock
          => Platform
          -> BlockMap Regs
          -> LiveBasicBlock instr
 -        -> (Bool, BlockMap Regs, LiveBasicBlock instr)
 +        -> (BlockMap Regs, LiveBasicBlock instr)
  livenessBlock platform blockmap (BasicBlock block_id instrs)
   = let
          (regsLiveOnEntry, instrs1)
              = livenessBack platform noRegs blockmap [] (reverse instrs)
 -        -- 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
 +        blockmap'       = mapInsert block_id regsLiveOnEntry blockmap
          instrs2         = livenessForward platform regsLiveOnEntry instrs1
          output          = BasicBlock block_id instrs2
 -   in   (changed, blockmap', output)
 +   in   ( blockmap', output)
  -- | Calculate liveness going forwards,
  --   filling in when regs are born