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
- - - - -
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
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d8a819e71e67f9e372cd92126f2fb63...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d8a819e71e67f9e372cd92126f2fb63...
You're receiving this email because of your account on gitlab.haskell.org.
