Simon Jakobi pushed to branch wip/sjakobi/T27368-cbe-compress at Glasgow Haskell Compiler / GHC Commits: df456631 by Simon Jakobi at 2026-08-31T17:15:50+02:00 Cmm: resolve substitution chains in common block elimination The substitution built by elimCommonBlocks could map a label to another eliminated label. The resulting Cmm graph edges to eliminated labels made setInfoTableStackMap panic later (#27368). Resolve the substitution before rewriting, so that every label in the graph is mapped directly to its final representative. See Note [Resolving the CBE substitution] in GHC.Cmm.CommonBlockElim. Also, copyTicks now copies each loser's ticks into its final representative instead of into a dead intermediate block. Fixes #27368. Assisted-by: Claude Fable 5 - - - - - 4 changed files: - + changelog.d/27368 - compiler/GHC/Cmm/CommonBlockElim.hs - + testsuite/tests/codeGen/should_compile/T27368.hs - testsuite/tests/codeGen/should_compile/all.T Changes: ===================================== changelog.d/27368 ===================================== @@ -0,0 +1,5 @@ +section: compiler +synopsis: Fix a ``setInfoTableStackMap`` panic caused by common block elimination + leaving references to eliminated blocks. +issues: #27368 +mrs: !16543 ===================================== compiler/GHC/Cmm/CommonBlockElim.hs ===================================== @@ -65,7 +65,7 @@ elimCommonBlocks g = assert (g_entry g == g_entry g') g' where g' = replaceLabels env $ copyTicks env g - env = iterate mapEmpty blocks_with_key + env = resolveSubst (iterate mapEmpty blocks_with_key) -- The order of blocks doesn't matter here. While we could use -- revPostorder which drops unreachable blocks this is done in -- ContFlowOpt already which runs before this pass. So we use @@ -86,6 +86,27 @@ elimCommonBlocks g = -- If we don't we end up with #27722 where the entry block was eliminated in favour -- of another block. +{- Note [Resolving the CBE substitution] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The substitution that `iterate` produces may contain chains +(k1 :-> k2, k2 :-> k3): the winner of one merge can lose a later one. +So before applying it we resolve each entry to the end of its chain +(resolveSubst). + +Applying the unresolved substitution instead would let replaceLabels leave +edges pointing at eliminated labels. Such edges can occur in blocks that +themselves lost a merge, i.e. in unreachable code, but even there they can be +harmful (see #27368). Also see Note [unreachable blocks] in GHC.Cmm.Pipeline. +-} + +-- | Resolve the substitution: follow chains (@k1 :-> k2@, @k2 :-> k3@) +-- to their ends, so that every eliminated label maps directly to its +-- final surviving representative. +-- +-- See Note [Resolving the CBE substitution]. +resolveSubst :: Subst -> Subst +resolveSubst env = mapMap (lookupBid env) env + -- Invariant: The blocks in the list are pairwise distinct -- (so avoid comparing them again) type DistinctBlocks = [CmmBlock] ===================================== testsuite/tests/codeGen/should_compile/T27368.hs ===================================== @@ -0,0 +1,21 @@ +-- The two branches share an identical suffix from the inner case +-- onwards, so common block elimination merges the duplicated call +-- blocks over several rounds, building a substitution chain. Without +-- resolving that chain, compiling this module at -O panicked in +-- setInfoTableStackMap (#27368). See +-- Note [Resolving the CBE substitution] in GHC.Cmm.CommonBlockElim. + +module T27368 (f) where + +{-# NOINLINE put #-} +put :: Int -> Int -> IO () +put h x = if h + x == 12345 then errorWithoutStackTrace "boom" else pure () + +data T = J Int | K + +f :: Int -> Bool -> T -> IO () +f h a t = do + if a + then do put h 1; case t of { J _ -> put h 3; K -> put h 4 }; put h 0; put h 0 + else do put h 2; case t of { J _ -> put h 3; K -> put h 4 }; put h 0; put h 0 + put h 0 ===================================== testsuite/tests/codeGen/should_compile/all.T ===================================== @@ -150,3 +150,5 @@ test('T16351', normal, compile, ['-O2 -ddump-simpl -dno-typeable-binds -dsuppres test('T20298a', normal, compile, ['-O2 -ddump-simpl -dno-typeable-binds -dsuppress-all -dsuppress-uniques']) test('T20298b', normal, compile, ['-O2 -dno-bignum-rules -ddump-simpl -dno-typeable-binds -dsuppress-all -dsuppress-uniques']) test('T20298c', normal, compile, ['-O2 -dno-builtin-rules -ddump-simpl -dno-typeable-binds -dsuppress-all -dsuppress-uniques']) + +test('T27368', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df456631c42be8a68c4ce2326fc541f5... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df456631c42be8a68c4ce2326fc541f5... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help