Simon Jakobi pushed to branch wip/sjakobi/T25181 at Glasgow Haskell Compiler / GHC Commits: 22a6adcc by Simon Jakobi at 2026-07-05T12:47:01+02:00 Simplifier: unbox through seq# on manifest values (#25181) For 'case seq# <manifest-value> s of (# s', r #) -> rhs' the Simplifier previously could neither let case-of-known-constructor see through r nor discard the seq#, so programs like T25181 retained a redundant box (and 480MB of allocation in the reproducer, vs 40KB on GHC 9.8). This patch adds three cooperating transformations in GHC.Core.Opt.Simplify.Iteration, restricted to manifest values (never merely-known-evaluated variables, which would reintroduce the #24334 unsoundness): * rebuildCase (0): ANF-ise a constructor argument of seq# when the result is scrutinised immediately, so that the unfolding below is expandable. * simplAlt: give the seq# result binder an unfolding pointing at the manifest-value argument, enabling case-of-known-constructor. * rebuildCase (2c): discard 'case seq# <manifest-value> s of (# s', _dead #) -> rhs' to rhs[s/s']. See the new (SEQ5) in Note [seq# magic] in GHC.Types.Id.Make. Adds the reproducer as perf test T25181. Assisted-by: Claude Fable 5 - - - - - 4 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Types/Id/Make.hs - + testsuite/tests/perf/should_run/T25181.hs - testsuite/tests/perf/should_run/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -3218,6 +3218,35 @@ rebuildCase, reallyRebuildCase -> SimplCont -> SimplM (SimplFloats, OutExpr) +-------------------------------------------------- +-- 0. ANF-ise a manifest-value seq# argument +-------------------------------------------------- + +rebuildCase (saf,env) scrut case_bndr alts@[Alt _ [_token, res] rhs] cont + -- ANF-ise `case seq# (Con e1 .. en) s of (# s', r #) -> case r of ...` + -- to `let a1 = e1 .. in case seq# (Con a1 .. an) s of ...`, so that + -- simplAlt can give `r` an *expandable* unfolding `Con a1 .. an` and + -- case-of-known-constructor can see through the seq#. + -- Guarded on `r` being scrutinised immediately, which guarantees that the + -- unfolding pays off; otherwise the let-floats would just be inlined back + -- on the next iteration. See (SEQ5) in Note [seq# magic] in GHC.Types.Id.Make + | (Var f, [ty_a, ty_s, arg, tok]) <- collectArgs scrut + , f `hasKey` seqHashKey + , scrutinises_res rhs + , exprIsManifestValue arg + , (_, con_args) <- collectArgs arg + , any (\a -> isValArg a && not (exprIsTrivial a)) con_args + = do { (anf_floats, arg') <- prepareRhs env NotTopLevel (fsLit "sat") arg + ; let floats = emptyFloats env `addLetFloats` anf_floats + env' = env `setInScopeFromF` floats + scrut' = Var f `mkApps` [ty_a, ty_s, arg', tok] + ; (floats2, expr') <- rebuildCase (saf,env') scrut' case_bndr alts cont + ; return (floats `addFloats` floats2, expr') } + where + scrutinises_res (Case (Var v) _ _ _) = v == res + scrutinises_res (Tick _ e) = scrutinises_res e + scrutinises_res _ = False + -------------------------------------------------- -- 1. Eliminate the case if there's a known constructor -------------------------------------------------- @@ -3292,7 +3321,21 @@ rebuildCase (saf,env) scrut case_bndr alts@[Alt _ bndrs rhs] cont ; (floats2, expr') <- simplExprF env' rhs cont ; return (floats1 `addFloats` floats2, expr') } - -- 2c. Try the seq rules if + -- 2c. Discard a seq# on a manifest value if its result is dead: + -- case seq# <manifest-value> s of (# s', _ #) -> rhs ==> rhs[s/s'] + -- See (SEQ5) in Note [seq# magic] in GHC.Types.Id.Make + | [token_out, res] <- bndrs + , isDeadBinder res, isDeadBinder case_bndr + , (Var f, [_ty1, _ty2, arg, Var token_in]) <- collectArgs scrut + , f `hasKey` seqHashKey + , exprIsManifestValue arg + , exprOkToDiscard arg + = do { tick (CaseElim case_bndr) + ; (floats1, env') <- simplAuxBind (saf,env) token_out (Var token_in) + ; (floats2, expr') <- simplExprF env' rhs cont + ; return (floats1 `addFloats` floats2, expr') } + + -- 2d. Try the seq rules if -- a) it binds only the case binder -- b) a rule for seq applies -- See Note [User-defined RULES for seq] in GHC.Types.Id.Make @@ -3317,6 +3360,24 @@ rebuildCase (saf,env) scrut case_bndr alts cont | otherwise = reallyRebuildCase (saf,env) scrut case_bndr alts cont +exprIsManifestValue :: OutExpr -> Bool +-- True of expressions that are values no matter what the context: +-- literals, lambdas, and (saturated or partial) constructor applications. +-- Unlike exprIsHNF, never true for a variable that is merely *known* to be +-- evaluated: for the seq#-discarding transformations that use this +-- predicate, such a variable carries a dependency on its binding site that +-- must not be lost. See (SEQ5) in Note [seq# magic] in GHC.Types.Id.Make. +exprIsManifestValue e = go e + where + go (Cast e _) = go e + go (Tick t e) = not (tickishCounts t) && go e + go (Lit _) = True + go (Lam b e) = isRuntimeVar b || go e + go (Var f) = isDataConWorkId f + go e@(App {}) | (Var f, _) <- collectArgs e + = isDataConWorkId f && exprIsHNF e + go _ = False + doCaseToLet :: OutExpr -- Scrutinee -> InId -- Case binder -> Bool @@ -3590,7 +3651,21 @@ simplAlt (saf,env) scrut' _ case_bndr' bndr_swap' cont' (Alt (DataAlt con) vs rh con_app = mkConApp2 con inst_tys' vs' env'' = addAltUnfoldings env' case_bndr' bndr_swap' con_app - ; rhs' <- simplAltExprC (saf,env'') rhs cont' + -- If the scrutinee is (seq# <manifest-value> s), record that + -- value as the unfolding of the result binder, so that + -- case-of-known-constructor can see through the seq#. + -- See (SEQ5) in Note [seq# magic] in GHC.Types.Id.Make + env_seq | Just scr <- scrut' + , isUnboxedTupleDataCon con + , [_token, res] <- vs' + , (Var f, [_ty1, _ty2, arg, _]) <- collectArgs scr + , f `hasKey` seqHashKey + , exprIsManifestValue arg + = addBinderUnfolding env'' res $ + mkSimpleUnfolding (seUnfoldingOpts env) arg + | otherwise = env'' + + ; rhs' <- simplAltExprC (saf,env_seq) rhs cont' ; return (Alt (DataAlt con) vs' rhs') } {- Note [Adding evaluatedness info to pattern-bound variables] ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -2516,6 +2516,43 @@ Things to note example in #24334 (immortalised as test T24334) for why it should be done in CorePrep. +(SEQ5) + T25181 shows that we additionally want to unbox through seq# when its + argument is a manifest value: + + case seq# (f x, y) s of (# s', p #) -> + case p of (a, b) -> rhs + + Evaluating a manifest value (a literal, lambda, or constructor application; + see exprIsManifestValue in GHC.Core.Opt.Simplify.Iteration) is a no-op, so + here seq# guarantees nothing beyond ordinary data dependencies; the only + remaining cost is the allocation of the value itself, which we want the + Simplifier to eliminate where possible. Hence three cooperating + transformations in GHC.Core.Opt.Simplify.Iteration: + + * rebuildCase (0) ANF-ises the seq# argument when the result is scrutinised + immediately: `let sat = f x in case seq# (sat, y) s of ...`. Without this + the unfolding below would be a con-app with non-trivial fields, which is + not *expandable*, so exprIsConApp_maybe would refuse to expand it and + case-of-known-constructor would never fire. + + * simplAlt gives `p` an unfolding `(sat, y)`, so that + case-of-known-constructor rewrites `case p of (a, b) -> rhs` to + `let a = sat; b = y in rhs`, typically making `p` dead. + + * rebuildCase (2c) then discards the seq# when its result is dead: + case seq# <manifest-value> s of (# s', _ #) -> rhs[s'] ==> rhs[s] + + Soundness: unlike the late, unsound seqRule of #24334, all transformations + demand a *manifest* value, not a variable that is merely known to be + evaluated (hence exprIsManifestValue, not exprIsHNF). Discarding + `seq# x s` for an evaluated variable `x` would lose the syntactic + dependency of the continuation on `x`, allowing lazy computations to float + past x's binding site and thereby evaluate too early; see the `pseq` + example in #24334. A manifest value, by contrast, converges unconditionally + and depends on nothing except its own (pure, discardable) field + expressions, so no ordering constraint is lost. + Implementing seq#. The compiler has magic for `seq#` in - GHC.CoreToStg.Prep.cpeRhsE: Implement (SEQ4). ===================================== testsuite/tests/perf/should_run/T25181.hs ===================================== @@ -0,0 +1,24 @@ +-- T25181 +import Control.Exception (evaluate) + +import Prelude hiding (repeat) + +repeat :: a -> [a] +repeat a = res + where res = a : res +{-# NOINLINE repeat #-} + +silly :: [(Int, Int)] -> IO () +silly = foldr go (pure ()) + where + go p r = do + (x, y) <- evaluate p + (x', y') <- evaluate (x + 3, y) + evaluate y' + r + +main :: IO () +-- 10,000,000 repetitions take only a twentieth of a second, +-- but allocations go up dramatically if the result is not +-- known evaluated. +main = silly $ take 10000000 $ repeat (1,1) ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -367,6 +367,12 @@ test('T15226a', compile_and_run, ['-O']) +test('T25181', + [collect_stats('bytes allocated',5), + only_ways(['normal'])], + compile_and_run, + ['-O']) + test('T15263', [collect_stats('bytes allocated', 4), only_ways(['normal'])], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22a6adcc7fc803de96661dd25808ab58... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22a6adcc7fc803de96661dd25808ab58... You're receiving this email because of your account on gitlab.haskell.org.