GitLab

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

Commits:

9fcce461
by Simon Jakobi at 2026-06-26T20:16:02+02:00
```
wibbles
```

835d3dea

by Simon Jakobi at 2026-06-27T17:00:54+02:00

Revert "wibbles"

This reverts commit 9fcce4619d747b088b543eda705322311bd354e6.

d20b381a

by Simon Jakobi at 2026-06-27T17:00:56+02:00

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

This reverts commit 94670147695768dab9a9cdb4c7f40334539e2d36.

f0b3eaa7

by Simon Jakobi at 2026-06-27T17:00:58+02:00

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

This reverts commit d8a819e71e67f9e372cd92126f2fb63bcdea0419.

Changes:

compiler/GHC/Cmm/Dataflow/Label.hs

@@ -35,7 +35,6 @@ module GHC.Cmm.Dataflow.Label
      , mapEmpty
      , mapSingleton
      , mapInsert
 -    , mapInsertLookup
      , mapInsertWith
      , mapDelete
      , mapAlter
@@ -200,14 +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)
 -{-# INLINE mapInsertLookup #-}
 -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,24 +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)
 +        blockmap'       = mapInsert block_id regsLiveOnEntry blockmap
          instrs2         = livenessForward platform regsLiveOnEntry instrs1
          output          = BasicBlock block_id instrs2
 -   -- 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. A single 'case' lets the pair from mapInsertLookup
 -   -- cancel away rather than being allocated.
 -   in   case mapInsertLookup block_id regsLiveOnEntry blockmap of
 -          (oldEntry, blockmap') ->
 -            (oldEntry /= Just regsLiveOnEntry, blockmap', output)
 +   in   ( blockmap', output)
  -- | Calculate liveness going forwards,
  --   filling in when regs are born