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.