Simon Peyton Jones pushed to branch wip/T27737 at Glasgow Haskell Compiler / GHC Commits: a9fdc56f by Simon Peyton Jones at 2026-10-09T17:40:35+01:00 More work in progress ...with Claude Very nice refactor. The hack does about what we hoped. Changes are relative to the original branch (casts always in inner), and only tests that moved by more than 0.5% are listed: ┌──────────────────┬───────────────────────┬───────────────────────────────────────────────────────────────────┐ │ Test │ Casts always in outer │ Hack (cast only into a single-alternative case or a non-join let) │ ├──────────────────┼───────────────────────┼───────────────────────────────────────────────────────────────────┤ │ CoOpt_Read │ +6.9% │ +5.6% (still a regression) │ ├──────────────────┼───────────────────────┼───────────────────────────────────────────────────────────────────┤ │ CoOpt_Singletons │ +6.1% │ 0.0% (fully recovered) │ ├──────────────────┼───────────────────────┼───────────────────────────────────────────────────────────────────┤ │ T13253 │ +3.7% │ +0.1% (recovered) │ ├──────────────────┼───────────────────────┼───────────────────────────────────────────────────────────────────┤ │ T13056 │ +1.1% │ +1.1% │ ├──────────────────┼───────────────────────┼───────────────────────────────────────────────────────────────────┤ │ T5642 │ −1.9% │ −1.9% (fix kept) │ ├──────────────────┼───────────────────────┼───────────────────────────────────────────────────────────────────┤ │ T16577 │ −1.5% │ −1.5% │ ├──────────────────┼───────────────────────┼───────────────────────────────────────────────────────────────────┤ │ T21839c │ −1.0% │ −1.0% │ ├──────────────────┼───────────────────────┼───────────────────────────────────────────────────────────────────┤ │ T19695 │ +0.8% │ −0.1% │ └──────────────────┴───────────────────────┴───────────────────────────────────────────────────────────────────┘ The other 56 tests are within 0.5%. Relative to master, CoOpt_Read is still about 3% better (it was 9% better with casts always pushed inside). CoOpt_Read is the only real loss left. It presumably gains from pushing a cast into a multi-alternative case, or into a join point, which the hack now forbids. The Core Lint bug. My reading is that it's caused by the hack, not latent: a cast pushed into a join point's RHS but not into a multi-alternative case in its body leaves a jump under a cast. The mightBeJoinBind test (no casts into a join-point let) fixes it, and the current tree builds cleanly with it. /tmp/tjoin/JoinCast.hs is a candidate reproducer of that shape: MkN (let j z = ... in case x of {0 -> j 1; 1 -> j 2; _ -> 3}). It passes Lint on master and on the current branch. I haven't yet seen it fail, because that needs the buggy state rebuilt, which means editing Iteration.hs. I'll do that only after your push, if you want it. State you're committing: - FloatBinds work, with addFloatBinds. - Your getFF and Note [LetFloats] changes, plus my comment fixes and the let-can-float and soft-scope assertions. - Soft-scoped ticks floated as FloatTicks. - The push_casts flag, with mightBeJoinBind. - Accepted outputs for T20510 and show-bytecode-hpc. - Tests: - The full testsuite was run before the push_casts change; the only unexpected failures were environmental ones and those two outputs, now accepted. - The push_casts version has only been built, and measured with the perf harness. simplCore and the full testsuite haven't been rerun on it. - - - - - 6 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - testsuite/tests/dmdanal/should_compile/T20510.stderr - testsuite/tests/show-bytecode/show-bytecode-hpc.stdout Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -1720,10 +1720,19 @@ isEmptyFloatBinds = isNilOL data FloatBind = FloatLet CoreBind + -- let(rec) x = e + -- Invariant: satisfies the let-can-float invariant + | FloatCase CoreExpr CoreBndr AltCon [CoreBndr] -- case e of y { C ys -> ... } -- See Note [Floating single-alternative cases] in GHC.Core.Opt.SetLevels + | FloatTick CoreTickish + -- tick<t> ... + -- Invariant: the tick is always soft-scoped (tickishHasSoftScope holds) + -- Why? We are floating these FloatBinds outwards, bringing more code under + -- the bindigns; that is only OK for soft-scoped ticks. + -- See Note [Scoping ticks and counting ticks] in GHC.Types.Tickish floatsBinders :: FloatBinds -> [Var] floatsBinders fs = foldr ((++) . floatBinders) [] fs ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -38,7 +38,7 @@ module GHC.Core.Opt.Simplify.Env ( -- * Floats SimplFloats(..), emptyFloats, isEmptyFloats, mkRecFloats, - mkFloatBind, addLetFloats, addJoinFloats, addFloats, + mkFloatBind, addLetFloats, addJoinFloats, addFloats, addFloatBindsF, extendFloats, wrapFloats, isEmptyJoinFloats, isEmptyLetFloats, doFloatFromRhs, getTopFloatBinds, @@ -79,6 +79,7 @@ import GHC.Types.Var.Set import GHC.Types.Id as Id import GHC.Types.InlinePragma ( ActivationGhc, CompilerPhase, isActiveInPhase ) import GHC.Types.Basic +import GHC.Types.Tickish ( CoreTickish, tickishCounts, tickishHasSoftScope ) import GHC.Types.Unique.FM ( pprUniqFM ) import GHC.Data.OrdList @@ -745,45 +746,56 @@ setSubstEnv env tvs cvs ids = env { seTvSubst = tvs, seCvSubst = cvs, seIdSubst Note [LetFloats] ~~~~~~~~~~~~~~~~ -The LetFloats is a bunch of bindings, classified by a FloatFlag. +The LetFloats is a bunch of FloatBinds, collectively classified by a FloatFlag. -The `FloatFlag` contains summary information about the bindings, see the data -type declaration of `FloatFlag` +The `FloatFlag` contains summary information about the bindings: see the data +type declaration of `FloatFlag`. A FloatBind can take one of three forms: +FloatLet, FloatCase, and FloatTick. We discuss the FloatFlag for each form. +Note [FloatFlag for FloatLet] -- see `getFF_Let` +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Examples - NonRec x (y:ys) FltLifted - Rec [(x,rhs)] FltLifted - - NonRec x* (p:q) FltOKSpec -- RHS is WHNF. Question: why not FltLifted? - NonRec x# (y +# 3) FltOkSpec -- Unboxed, but ok-for-spec'n - - NonRec x* (f y) FltCareful -- Strict binding; might fail or diverge - NonRec x# (a /# b) FltCareful -- Might fail; does not satisfy let-can-float invariant - NonRec x# (f y) FltCareful -- Might diverge; does not satisfy let-can-float invariant - -A binding that does not satisfy the let-can-float invariant (the last two -examples above) is represented by a FloatCase, not a FloatLet: - FloatCase (a /# b) x# DEFAULT [] -That is done once and for all by `unitLetFloat`, so a FloatLet in a LetFloats -is always a valid let-binding, and `wrapFloats` does not need to check. -Such bindings can arise from `makeTrivial`, because an argument need not -satisfy the let-can-float invariant. They also arise because -exprOkForSpeculation is conservative: e.g. it says False for (# s, x #) -where x is lifted, because it checks the arguments against the -(representation-polymorphic) type of the unboxed-tuple worker. - -However, a FloatLet can still be FltCareful: the first FltCareful example -above, NonRec x* (f y), where x* is lifted but has a strict demand -(isStrUsedDmd). That is a perfectly valid (lazy) let-binding, but its demand -info is valid only where it is. If we floated it out of the RHS of a lazy -binding - let v = let x* = f y in x*+1 in body - ==> let x* = f y; v = x*+1 in body -then x's demand info would be a lie, and CorePrep, which case-binds a let -whose binder has a strict demand, would evaluate (f y) eagerly. Hence -FltCareful, which doFloatFromRhs allows to float only out of a strict binding. - + NonRec x (y:ys) FltLifted + Rec [(x,rhs)] FltLifted + + NonRec x* (p:q) FltOKSpec -- RHS is WHNF. Question: why not FltLifted? + NonRec x# (y +# 3) FltOkSpec -- Unboxed, but ok-for-spec'n + + NonRec x* (f y) FltCareful -- Strict binding; might fail or diverge + NonRec x# (a /# b) FltCareful -- Might fail; does not satisfy let-can-float invariant + NonRec x# (f y) FltCareful -- Might diverge; does not satisfy let-can-float invariant + + NonRec s "foo"# FltLifted -- Literal string can go to top level + +* (FFL1) Note that a FloatLet can still be FltCareful: the first FltCareful example + above, NonRec x* (f y), where x* is lifted but has a strict demand + (isStrUsedDmd). That is a perfectly valid (lazy) let-binding, but its demand + info is valid only where it is. If we floated it out of the RHS of a lazy + binding + let v = let x* = f y in x*+1 in body + ==> let x* = f y; v = x*+1 in body + then x's demand info would be a lie, and CorePrep, which case-binds a let + whose binder has a strict demand, would evaluate (f y) eagerly. Hence + FltCareful, which doFloatFromRhs allows to float only out of a strict binding. + +* (FFL2) A literal-string binding is marked FltLifted (a bit of a mis-nomer + because it's not a lifted type) because it can go to top level. + See Note [Core top-level string literals] in GHC.Core. + +* A binding that does not satisfy the let-can-float invariant (the last two + examples above) is represented by a FloatCase, not a FloatLet: + FloatCase (a /# b) x# DEFAULT [] + That is done once and for all by `unitLetFloat`, so a FloatLet in a LetFloats + is always a valid let-binding, and `wrapFloats` does not need to check. + Such bindings can arise from `makeTrivial`, because an argument need not + satisfy the let-can-float invariant. They also arise because + exprOkForSpeculation is conservative: e.g. it says False for (# s, x #) + where x is lifted, because it checks the arguments against the + (representation-polymorphic) type of the unboxed-tuple worker. + +Note [FloatFlag for FloatCase] -- see `getFF_Case` +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As well as let-bindings, a LetFloats can contain single-alternative case floats (FloatCase), for example case e of b { (# a, c #) -> <hole> } @@ -795,12 +807,29 @@ These are classified just like a strict binding: Being strict they are never FltLifted, so they never float to top level or into a recursive group. -Currently, we never put a FloatTick in a LetFloats. +Note [FloatFlag for FloatTick] -- see `getFF_Tick` +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A LetFloats can contain a FloatTick for soft-scoped ticks (only -- see the +invariant on FloatTick in GHC.Core). + +* We certainly don't want a tick to go to top level, or into a recursive group, + so its FloatFlag is never FltLifted. + +* A /non-counting/ tick (e.g. a source note) is FltOkSpec. Floating it out of + the RHS of a lazy binding + let x = tick<t> (let y = e1 in e2) in body + ==> tick<t> (let y = e1 in let x = e2 in body) + just brings more code (here `body`) under the tick, which is fine for a + soft-scoped tick. + +* A /counting/ tick (e.g. an HPC tick) is FltCareful. Floating it out of a lazy + RHS would change when (and how often) it is counted: when the let is + executed rather than when `x` is evaluated. -} data LetFloats = LetFloats FloatBinds FloatFlag -- See Note [LetFloats] - -- Contains only FloatLet and FloatCase; never FloatTick + -- Invariant: every FloatLet satisfies the let-can-float invariant type JoinFloat = OutBind type JoinFloats = OrdList JoinFloat @@ -817,7 +846,7 @@ data FloatFlag -- *and* ok-for-speculation -- Hence ok to float out of the RHS -- of a lazy non-recursive let binding - -- (but not to top level, or into a rec group) + -- (but /not/ to top level, or into a rec group) -- NB: consequence: all bindings satisfy let-can-float invariant | FltCareful -- At least one binding is strict (or unlifted) @@ -899,37 +928,50 @@ emptyJoinFloats = nilOL isEmptyJoinFloats :: JoinFloats -> Bool isEmptyJoinFloats = isNilOL +getFF :: FloatBind -> FloatFlag +getFF (FloatCase e _ _ _) = getFF_Case e +getFF (FloatLet b) = getFF_Let b +getFF (FloatTick t) = getFF_Tick t + +getFF_Let :: CoreBind -> FloatFlag +-- See Note [FloatFlag for FloatLet] +getFF_Let (Rec {}) = FltLifted +getFF_Let (NonRec bndr rhs) + | not (isStrictId bndr) = FltLifted -- Lazy lifted let + | exprIsTickedString rhs = FltLifted -- See (FFL2) + | exprOkForSpeculation rhs = FltOkSpec -- Unlifted, or strict lifted, and ok-for-spec (e.g. HNF) + | otherwise = FltCareful -- See (FFL1) Strict, e.g. let x* = factorial y + +getFF_Case :: CoreExpr -> FloatFlag -- The CoreExpr is the scrutinee +-- Note [FloatFlag for FloatCase] +getFF_Case scrut | exprOkForSpeculation scrut = FltOkSpec + | otherwise = FltCareful + +getFF_Tick :: CoreTickish -> FloatFlag +-- See Note [FloatFlag for FloatTick] +getFF_Tick t | tickishCounts t = FltCareful + | otherwise = FltOkSpec + unitLetFloat :: OutBind -> LetFloats -- This key function constructs a singleton float with the right form -- If the binding does not satisfy the let-can-float invariant, it -- makes a FloatCase. See Note [LetFloats] -unitLetFloat bind = assert (all (not . isJoinId) (bindersOf bind)) $ - mk_float bind - where - mk_float bind@(Rec {}) = let_float FltLifted bind - mk_float bind@(NonRec bndr rhs) - | not (isStrictId bndr) = let_float FltLifted bind - | exprIsTickedString rhs = let_float FltLifted bind - -- String literals can be floated freely. - -- See Note [Core top-level string literals] in GHC.Core. - | exprOkForSpeculation rhs = let_float FltOkSpec bind -- Unlifted, and lifted but ok-for-spec (eg HNF) - | needsCaseBinding (idType bndr) rhs - = pprTrace "TMP-unitLetFloat-case" (ppr bind) $ - LetFloats (unitOL (FloatCase rhs bndr DEFAULT [])) FltCareful - -- Unlifted, and not ok-for-spec: does not satisfy let-can-float invariant - | otherwise = let_float FltCareful bind - - let_float flag bind = LetFloats (unitOL (FloatLet bind)) flag +unitLetFloat bind + | NonRec bndr rhs <- bind + , needsCaseBinding (idType bndr) rhs + = -- This should never happen, but currently does because of #27910 + LetFloats (unitOL (FloatCase rhs bndr DEFAULT [])) FltCareful + + | otherwise + = assert (all (not . isJoinId) (bindersOf bind)) $ + LetFloats (unitOL (FloatLet bind)) (getFF_Let bind) unitCaseFloat :: OutExpr -> OutId -> AltCon -> [OutVar] -> LetFloats -- Constructs a singleton single-alternative case float -- case scrut of bndr { con bndrs -> <hole> } -- See Note [LetFloats] unitCaseFloat scrut bndr con bndrs - = LetFloats (unitOL (FloatCase scrut bndr con bndrs)) flag - where - flag | exprOkForSpeculation scrut = FltOkSpec - | otherwise = FltCareful + = LetFloats (unitOL (FloatCase scrut bndr con bndrs)) (getFF_Case scrut) unitJoinFloat :: OutBind -> JoinFloats unitJoinFloat bind = assert (all isJoinId (bindersOf bind)) $ @@ -978,12 +1020,34 @@ addLetFloats :: SimplFloats -> LetFloats -> SimplFloats -- Add the let-floats for env2 to env1; -- *plus* the in-scope set for env2, which is bigger -- than that for env1 -addLetFloats floats let_floats +addLetFloats floats let_floats@(LetFloats fbs _) = floats { sfLetFloats = sfLetFloats floats `addLetFlts` let_floats - , sfInScope = sfInScope floats `extendInScopeFromLF` let_floats } - -extendInScopeFromLF :: InScopeSet -> LetFloats -> InScopeSet -extendInScopeFromLF in_scope (LetFloats binds _) + , sfInScope = sfInScope floats `extendInScopeFromFB` fbs } + +addFloatBindsF :: FloatBinds -> SimplFloats -> SimplFloats +-- (addFloatBindsF new_fbs floats) adds `new_fbs` /outside/ `floats`; +-- i.e. `new_fbs` scope over `floats` +-- Precondition: every FloatLet in `new_fbs` satisfies the let-can-float +-- invariant (see the FloatBind declaration in GHC.Core), so we can add +-- them directly; see Note [LetFloats] +addFloatBindsF new_fbs floats@(SimplFloats { sfLetFloats = LetFloats lf_fbs lf_ff + , sfInScope = in_scope }) + | isNilOL new_fbs + = floats + | otherwise + = assertPpr (all ok_float new_fbs) (ppr new_fbs) $ + floats { sfLetFloats = LetFloats (new_fbs `appOL` lf_fbs) + (foldr (andFF . getFF) lf_ff new_fbs) + , sfInScope = in_scope `extendInScopeFromFB` new_fbs } + where + -- Check the invariants on FloatBind; see its declaration in GHC.Core + ok_float (FloatLet (NonRec b r)) + | isId b, not (isCoVar b) = not (needsCaseBinding (idType b) r) + ok_float (FloatTick t) = tickishHasSoftScope t + ok_float _ = True + +extendInScopeFromFB :: InScopeSet -> FloatBinds -> InScopeSet +extendInScopeFromFB in_scope binds = foldlOL extend in_scope binds where extend in_scope (FloatLet bind) = in_scope `extendInScopeSetBind` bind ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -66,7 +66,7 @@ import GHC.Builtin.WiredIn.Ids( seqId ) import qualified GHC.Data.List.Infinite as Inf import GHC.Data.Maybe ( isNothing, orElse, mapMaybe ) import GHC.Data.FastString -import GHC.Data.OrdList ( fromOL ) -- TMP +import GHC.Data.OrdList ( unitOL ) import GHC.Unit.Module ( moduleName ) import GHC.Utils.Outputable import GHC.Utils.Panic @@ -1287,7 +1287,8 @@ simplExprF1 env expr@(Lam {}) cont -- and likewise drop counts all binders (incl type lambdas) simplExprF1 env expr@(Case scrut bndr _ alts) cont - | Just (inner, outer) <- splitContForNoCaseCase env cont + | Just (inner, outer) <- splitContForNoCaseCase env (isSingleton alts) cont + -- isSingleton: push casts inside only if there is just one alternative -- See (COC-INV) in Note [sm_case_case: switching off case continuations] = do { (floats, expr') <- simplExprF env expr inner ; rebuildWithFloats env floats expr' outer } @@ -1314,9 +1315,12 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont tick (PreInlineUnconditionally bndr) ; simplExprF env' body cont } -simplExprF1 env expr@(Let {}) cont - | Just (inner, outer) <- splitContForNoCaseCase env cont +simplExprF1 env expr@(Let bind _) cont + | Just (inner, outer) <- splitContForNoCaseCase env (not (mightBeJoinBind bind)) cont -- See (COC-INV) in Note [sm_case_case: switching off case continuations] + -- mightBeJoinBind: do not push a cast into a join point's RHS, because + -- then we'd have to push it to every jump, including those in + -- multi-alternative cases, where we don't want to push casts = do { (floats, expr') <- simplExprF env expr inner ; rebuildWithFloats env floats expr' outer } @@ -1342,13 +1346,22 @@ simplExprF1 env (Let (Rec pairs) body) cont simplRecE env pairs body cont -splitContForNoCaseCase :: SimplEnv -> SimplCont +mightBeJoinBind :: InBind -> Bool +-- True if joinPointBind_maybe might succeed; cheap and conservative +mightBeJoinBind bind = any might_be_join (bindersOf bind) + where + might_be_join b = isId b && (isJoinId b || isAlwaysTailCalled (idOccInfo b)) + +splitContForNoCaseCase :: SimplEnv + -> Bool -- True <=> casts may go in `inner` + -> SimplCont -> Maybe (SimplCont, SimplCont) -- When seCaseCase is off, this function splits `cont` into (inner, outer), --- where `inner` has only applications, and `outer` is non-trivial -splitContForNoCaseCase env cont +-- where `inner` has only applications (and perhaps casts), and `outer` is +-- non-trivial. See splitContArgs for the Bool. +splitContForNoCaseCase env push_casts cont | seCaseCase env = Nothing - | otherwise = splitContArgs cont + | otherwise = splitContArgs push_casts cont {- Note [Avoiding space leaks in OutType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1503,10 +1516,16 @@ simplTick env tickish expr cont -- push the continuation inside the tick. This has the effect of moving the -- tick to the outside of a case or application context, allowing the normal -- 'case' and 'application' optimisations to fire. + -- + -- We return the tick as a FloatTick, /outside/ the floats from `expr`. + -- So all the code that was covered by the tick (including the floats, + -- notably single-alternative case floats) remains covered, as soft scope + -- requires; and yet `expr'` is exposed to the caller, e.g. for + -- case-of-known-constructor in rebuildWithFloats. + -- See Note [FloatFlag for FloatTick] in GHC.Core.Opt.Simplify.Env | tickishHasSoftScope tickish = do { (floats, expr') <- simplExprF env expr cont - ; return (floats, mkTick tickish expr') - } + ; return (unitOL (FloatTick tickish) `addFloatBindsF` floats, expr') } -- Push tick inside if the context looks like this will allow us to -- do a case-of-case - see Note [case-of-scc-of-case] @@ -2431,7 +2450,7 @@ simplOutId env fun cont , ApplyToTy { sc_cont = cont2 } <- cont1 , ApplyToVal { sc_cont = cont3, sc_arg = arg, sc_env = arg_se , sc_cast = arg_mco, sc_hole_ty = fun_ty } <- cont2 - = case splitContForNoCaseCase env cont3 of + = case splitContForNoCaseCase env True cont3 of Nothing -> do { e' <- simplRunRW env fun arg arg_se arg_mco fun_ty cont3 ; return (emptyFloats env, e') } Just (ink,outk) -> do { e' <- simplRunRW env fun arg arg_se arg_mco fun_ty ink @@ -2838,14 +2857,10 @@ fireRuleAFTER env rule_match arg_specs cont | RM { rm_rule = rule, rm_rhs = rhs, rm_args = rhs_args , rm_floats = float_bs } <- rule_match = do { let env' = env `addNewInScopeIds` floatsBinders float_bs - ; (floats, e') <- simplExprF env' rhs $ - pushOutArgs (exprType rhs) rhs_args $ - pushArgSpecs (drop (ruleArity rule) arg_specs) cont - ; return $ - if isEmptyFloatBinds float_bs -- Not very pretty - then (floats, e') - else (emptyFloats env', GHC.Core.Make.wrapFloats float_bs $ - wrapFloats floats e') } + ; addFloatBinds (contHoleScaling cont) float_bs $ + simplExprF env' rhs $ + pushOutArgs (exprType rhs) rhs_args $ + pushArgSpecs (drop (ruleArity rule) arg_specs) cont } tryRules :: SimplEnv -> [CoreRule] @@ -3553,7 +3568,6 @@ robust here. (Otherwise, there's a danger that we'll simply drop the Note [Scaling in case-of-case] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - When two cases commute, if done naively, the multiplicities will be wrong: case (case u of w[1] { (x[1], y[1]) } -> f x y) of w'[Many] @@ -3991,22 +4005,22 @@ All this should happen in one sweep. Note [FloatBinds from constructor wrappers] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If we have FloatBinds coming from the constructor wrapper -(as in Note [exprIsConApp_maybe on data constructors with wrappers]), -we cannot float past them. We'd need to float the FloatBind -together with the simplify floats, unfortunately the -simplifier doesn't have case-floats. The simplest thing we can -do is to wrap all the floats here. The next iteration of the -simplifier will take care of all these cases and lets. +exprIsConApp_maybe may return FloatBinds, e.g. coming from a constructor +wrapper (as in Note [exprIsConApp_maybe on data constructors with wrappers]), +or from looking through lets and single-alternative cases in the scrutinee. +These floats scope over the result of case-of-known-constructor. + +Since the Simplifier's floats can contain case-floats as well as let-floats +(see Note [LetFloats] in GHC.Core.Opt.Simplify.Env), we simply add them to +the SimplFloats, outside the floats from simplifying the alternative; see +knownConCase_maybe. We do not wrap them around the result, because then a +subsequent case-of-known-constructor on the result would have to walk +through them all over again, which can be quadratic (#27737). Given data T = MkT !Bool, this allows us to simplify case $WMkT b of { MkT x -> f x } to case b of { b' -> f b' }. - -We could try and be more clever (like maybe `wfloats` only contains -let binders, so we could float them). But the need for the extra -complication is not clear. -} knownConCase_maybe :: (SimplAltFlag, SimplEnv) @@ -4033,58 +4047,27 @@ knownConCase_maybe (saf,env) scrut case_bndr alts cont -- as well as when it's an explicit constructor application , let env0 = setInScopeSet env in_scope' = Just $ - (if isEmptyFloatBinds wfloats then id else - pprTrace "TMP-knownCon" (vcat [ text "nfloats" <+> ppr (length (fromOL wfloats)) - , text "scrut" <+> ppr scrut ])) $ do { tick (KnownBranch case_bndr) ; let -- case_bndr_unf: see Note [Do not duplicate constructor applications] case_bndr_rhs | exprIsTrivial scrut = scrut | otherwise = con_app con_app = Var (dataConWorkId con) `mkTyApps` ty_args `mkApps` other_args - ; wrapDataConFloats env wfloats case_bndr cont $ + -- The wfloats scope over the result + -- See Note [FloatBinds from constructor wrappers] + ; addFloatBinds hole_scaling wfloats $ case findAlt (DataAlt con) alts of Nothing -> missingAlt env0 case_bndr alts cont Just (Alt DEFAULT bs rhs) -> simpl_rhs env0 case_bndr_rhs bs rhs Just (Alt _ bs rhs) -> knownCon env0 scrut con other_args - case_bndr bs rhs cont - } + case_bndr bs rhs cont } | otherwise = Nothing where - simpl_rhs env case_bndr_rhs bs rhs - = assert (null bs) $ - do { (floats1, env') <- simplAuxBind (saf,env) case_bndr case_bndr_rhs - -- scrut is a constructor application, - -- hence satisfies let-can-float invariant - ; (floats2, expr') <- simplExprF env' rhs cont - ; return (floats1 `addFloats` floats2, expr') } - -wrapDataConFloats :: SimplEnv -> FloatBinds -> InId -> SimplCont - -> SimplM (SimplFloats, OutExpr) - -> SimplM (SimplFloats, OutExpr) --- See Note [FloatBinds from constructor wrappers] -wrapDataConFloats env wfloats case_bndr cont thing_inside - | isEmptyFloatBinds wfloats - = thing_inside - | otherwise - = do { (floats, expr) <- thing_inside - ; return ( emptyFloats env - , GHC.Core.Make.wrapFloats (fmap scale_float wfloats) $ - wrapFloats floats expr ) } - where - -- scale_float scales case-floats by the multiplicity of the continuation hole - -- (see Note [Scaling in case-of-case]). - -- Let floats are _not_ scaled, because they are aliases anyway. - scale_float (GHC.Core.FloatCase scrut case_bndr con vars) - = GHC.Core.FloatCase scrut (scale_id case_bndr) con (map scale_id vars) - scale_float flt@(GHC.Core.FloatLet {}) = flt - scale_float flt@(GHC.Core.FloatTick {}) = flt - - scale_id id = scaleVarBy holeScaling id - - holeScaling = contHoleScaling cont `mkMultMul` idMult case_bndr + hole_scaling = idMult case_bndr `mkMultMul` contHoleScaling cont + -- See Note [Scaling in case-of-case] + -- This is the contHoleScaling of the original Select continuation -- We are in the following situation -- case[p] case[q] u of { D x -> C v } of { C x -> w } -- And we are producing case[??] u of { D x -> w[x\v]} @@ -4100,6 +4083,33 @@ wrapDataConFloats env wfloats case_bndr cont thing_inside -- Which is ill-typed with respect to linearity. So it needs to be a -- case[Many]. + simpl_rhs env case_bndr_rhs bs rhs + = assert (null bs) $ + do { (floats1, env') <- simplAuxBind (saf,env) case_bndr case_bndr_rhs + -- scrut is a constructor application, + -- hence satisfies let-can-float invariant + ; (floats2, expr') <- simplExprF env' rhs cont + ; return (floats1 `addFloats` floats2, expr') } + +addFloatBinds :: Mult -> FloatBinds + -> SimplM (SimplFloats, a) -> SimplM (SimplFloats, a) +-- (addFloatBinds scaling fbs thing_inside) adds `fbs` outside the floats +-- returned by `thing_inside`. The `scaling` is the multiplicity of the +-- continuation hole, by which case-floats are scaled, because they now +-- scope over that continuation: see Note [Scaling in case-of-case]. +-- Let floats do not need this treatment +addFloatBinds scaling fbs thing_inside + | isEmptyFloatBinds fbs -- Short cut + = thing_inside + | otherwise + = do { (floats, res) <- thing_inside + ; return (fmap scale_float fbs `addFloatBindsF` floats, res) } + where + scale_float (FloatCase scrut b con vars) + = FloatCase scrut (scale_id b) con (map scale_id vars) + scale_float flt = flt + + scale_id id = scaleVarBy scaling id knownCon :: SimplEnv -> OutExpr -- The scrutinee ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -632,19 +632,24 @@ contOutArgs env cont -- No more arguments go _ = [] -splitContArgs :: SimplCont -> Maybe (SimplCont, SimplCont) --- Splits `cont` into (inner, outer), where `inner` has only --- applications and casts, and `outer` is non-trivial -splitContArgs cont@(ApplyToTy { sc_cont = cont1 }) - = do { (inner, outer) <- splitContArgs cont1 +splitContArgs :: Bool -> SimplCont -> Maybe (SimplCont, SimplCont) +-- (splitContArgs push_casts cont) splits `cont` into (inner, outer), where +-- `inner` has only applications, and casts if `push_casts` is True; +-- and `outer` is non-trivial. +-- The caller sets `push_casts` to False if `inner` will be pushed into many +-- case alternatives: pushing a cast into each of them duplicates the +-- coercion, which can be big (T5642) +splitContArgs push_casts cont@(ApplyToTy { sc_cont = cont1 }) + = do { (inner, outer) <- splitContArgs push_casts cont1 ; return (cont { sc_cont = inner }, outer) } -splitContArgs cont@(ApplyToVal { sc_cont = cont1 }) - = do { (inner, outer) <- splitContArgs cont1 +splitContArgs push_casts cont@(ApplyToVal { sc_cont = cont1 }) + = do { (inner, outer) <- splitContArgs push_casts cont1 ; return (cont { sc_cont = inner }, outer) } -splitContArgs cont@(CastIt { sc_cont = cont1 }) - = do { (inner, outer) <- splitContArgs cont1 +splitContArgs push_casts cont@(CastIt { sc_cont = cont1 }) + | push_casts + = do { (inner, outer) <- splitContArgs push_casts cont1 ; return (cont { sc_cont = inner }, outer) } -splitContArgs outer +splitContArgs _ outer | contIsStop outer = Nothing | otherwise = -- pprTrace "splitContHoleType" (ppr hole_ty) $ return (mkBoringStop hole_ty, outer) ===================================== testsuite/tests/dmdanal/should_compile/T20510.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Exitification transformation ==================== Result size of Exitification transformation - = {terms: 50, types: 22, coercions: 0, joins: 2/2} + = {terms: 33, types: 15, coercions: 0, joins: 2/2} -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} lvl :: Int @@ -11,7 +11,7 @@ lvl :: Int Guidance=IF_ARGS [] 10 10}] lvl = GHC.Internal.Types.I# 0# --- RHS size: {terms: 32, types: 14, coercions: 0, joins: 2/2} +-- RHS size: {terms: 29, types: 12, coercions: 0, joins: 2/2} small :: Int -> Int [LclIdX, Arity=1, @@ -22,7 +22,7 @@ small :: Int -> Int Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (x [Dmd=S!P(SL)] :: Int) -> joinrec { - go [InlPrag=[2], Occ=T[2], Dmd=LC(S,C(1,!P(L)))] + go [InlPrag=[2], Occ=Many(T[2]), Dmd=LC(S,C(1,!P(L)))] :: Int -> Int -> Int [LclId[JoinId(2)(Nothing)], Arity=2, @@ -54,11 +54,11 @@ small :: Int -> Int Guidance=IF_ARGS [0 51] 63 10}] $wgo (ww [Occ=Once2] :: GHC.Internal.Prim.Int#) (ww [Occ=Once1!, Dmd=SL] :: GHC.Internal.Prim.Int#) - = case ww of ds { + = case ww of wild { __DEFAULT -> jump go - (GHC.Internal.Types.I# (GHC.Internal.Prim.+# ww ds)) - (GHC.Internal.Types.I# (GHC.Internal.Prim.-# ds 1#)); + (GHC.Internal.Types.I# (GHC.Internal.Prim.+# ww wild)) + (GHC.Internal.Types.I# (GHC.Internal.Prim.-# wild 1#)); 0# -> case x of { GHC.Internal.Types.I# y [Occ=Once1] -> GHC.Internal.Types.I# (GHC.Internal.Prim.*# ww y) @@ -67,13 +67,12 @@ small :: Int -> Int jump go lvl x}] small = \ (x [Dmd=S!P(SL)] :: Int) -> + case x of { GHC.Internal.Types.I# ww [Dmd=SL] -> join { exit :: GHC.Internal.Prim.Int# -> Int [LclId[JoinId(1)(Nothing)]] exit (ww :: GHC.Internal.Prim.Int#) - = case x of { GHC.Internal.Types.I# y -> - GHC.Internal.Types.I# (GHC.Internal.Prim.*# ww y) - } } in + = GHC.Internal.Types.I# (GHC.Internal.Prim.*# ww ww) } in joinrec { $wgo [InlPrag=[2], Occ=LoopBreaker] :: GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> Int @@ -82,56 +81,17 @@ small Str=<L><SL>, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [0 32] 43 10}] + Guidance=IF_ARGS [0 32] 33 10}] $wgo (ww :: GHC.Internal.Prim.Int#) (ww [Dmd=SL] :: GHC.Internal.Prim.Int#) - = case ww of ds { + = case ww of wild { __DEFAULT -> jump $wgo - (GHC.Internal.Prim.+# ww ds) (GHC.Internal.Prim.-# ds 1#); + (GHC.Internal.Prim.+# ww wild) (GHC.Internal.Prim.-# wild 1#); 0# -> jump exit ww }; } in - case x of { GHC.Internal.Types.I# ww [Dmd=SL] -> jump $wgo 0# ww } - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -$trModule :: GHC.Internal.Prim.Addr# -[LclId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -$trModule = "main"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$trModule :: GHC.Internal.Types.TrName -[LclId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -$trModule = GHC.Internal.Types.TrNameS $trModule - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -$trModule :: GHC.Internal.Prim.Addr# -[LclId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -$trModule = "T20510"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$trModule :: GHC.Internal.Types.TrName -[LclId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -$trModule = GHC.Internal.Types.TrNameS $trModule - --- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T20510.$trModule :: GHC.Internal.Types.Module -[LclIdX, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T20510.$trModule = GHC.Internal.Types.Module $trModule $trModule + jump $wgo 0# ww + } ===================================== testsuite/tests/show-bytecode/show-bytecode-hpc.stdout ===================================== @@ -59,135 +59,133 @@ objects: arity: 0 literals: label ‘_hpc_tickboxes_Example_hpc’ used items: named item ‘primes’ - object ‘primes2_@name_suffix@’: + object ‘primes’: arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: - object ‘primes2_sat_@name_suffix@’: - arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: - object ‘primes2_sat_@name_suffix@’: - arity: 0 - literals: - label ‘_hpc_tickboxes_Example_hpc’ - word 3 - info table of ‘IS’ - used items: - named item ‘$fNumNatural’ - named item ‘fromInteger’ - named item ‘$fEnumNatural’ - named item ‘enumFrom’ - object ‘primes2_sat_@name_suffix@’: - arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: named item ‘isPrime_@name_suffix@’ - named item ‘filter’ - object ‘isPrime_@name_suffix@’: - arity: 1 literals: label ‘_hpc_tickboxes_Example_hpc’ + info table of ‘(:)’ used items: - object ‘isPrime_sat_@name_suffix@’: + object ‘isPrime_@name_suffix@’: arity: 1 - literals: label ‘_hpc_tickboxes_Example_hpc’ + literals: + label ‘_hpc_tickboxes_Example_hpc’ used items: - object ‘isPrime_sat_@name_suffix@’: + object ‘isPrime_primes_sat_@name_suffix@’: arity: 1 literals: label ‘_hpc_tickboxes_Example_hpc’ used items: - object ‘isPrime_sat_@name_suffix@’: - arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: named item ‘primes’ - object ‘isPrime_sat_@name_suffix@’: + object ‘isPrime_primes_sat_@name_suffix@’: arity: 1 literals: label ‘_hpc_tickboxes_Example_hpc’ used items: - object ‘isPrime_sat_@name_suffix@’: + object ‘isPrime_primes_sat_@name_suffix@’: arity: 0 literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: - object ‘v_@name_suffix@’: - arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: - named item ‘$fIntegralInteger’ - named item ‘$fNumNatural’ - named item ‘(^)’ - object ‘v1_@name_suffix@’: - arity: 0 - literals: - label ‘_hpc_tickboxes_Example_hpc’ - word 2 - info table of ‘IS’ - used items: <none> - object ‘pap_@name_suffix@’: - arity: 3 - literals: <none> - used items: <none> - object ‘isPrime_sat_@name_suffix@’: + used items: named item ‘primes’ + object ‘isPrime_primes_sat_@name_suffix@’: arity: 1 literals: label ‘_hpc_tickboxes_Example_hpc’ used items: - object ‘v_@name_suffix@’: + object ‘isPrime_primes_sat_@name_suffix@’: arity: 0 literals: label ‘_hpc_tickboxes_Example_hpc’ used items: - named item ‘$fOrdNatural’ - named item ‘(<=)’ - object ‘v1_@name_suffix@’: + object ‘v_@name_suffix@’: + arity: 0 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: + named item ‘$fIntegralInteger’ + named item ‘$fNumNatural’ + named item ‘(^)’ + object ‘v1_@name_suffix@’: + arity: 0 + literals: + label ‘_hpc_tickboxes_Example_hpc’ + word 2 + info table of ‘IS’ + used items: <none> + object ‘pap_@name_suffix@’: + arity: 3 + literals: <none> + used items: <none> + object ‘isPrime_primes_sat_@name_suffix@’: arity: 1 literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: <none> + used items: + object ‘v_@name_suffix@’: + arity: 0 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: + named item ‘$fOrdNatural’ + named item ‘(<=)’ + object ‘v1_@name_suffix@’: + arity: 1 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: <none> + object ‘pap_@name_suffix@’: + arity: 3 + literals: <none> + used items: <none> + named item ‘(.)’ + named item ‘takeWhile’ + object ‘isPrime_primes_sat_@name_suffix@’: + arity: 1 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: + object ‘v_@name_suffix@’: + arity: 0 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: object ‘pap_@name_suffix@’: - arity: 3 + arity: 2 literals: <none> - used items: <none> - named item ‘(.)’ - named item ‘takeWhile’ - object ‘isPrime_sat_@name_suffix@’: - arity: 1 + used items: + named item ‘$fIntegralNatural’ + named item ‘divides’ + object ‘v1_@name_suffix@’: + arity: 1 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: <none> + object ‘pap_@name_suffix@’: + arity: 3 + literals: <none> + used items: <none> + named item ‘$fFoldableList’ + named item ‘any’ + named item ‘not’ + object ‘primes_sat_@name_suffix@’: + arity: 1 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: + object ‘primes_sat_@name_suffix@’: + arity: 0 literals: label ‘_hpc_tickboxes_Example_hpc’ used items: - object ‘v_@name_suffix@’: + object ‘primes_sat_@name_suffix@’: arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ + literals: + label ‘_hpc_tickboxes_Example_hpc’ + word 3 + info table of ‘IS’ used items: - object ‘pap_@name_suffix@’: - arity: 2 - literals: <none> - used items: - named item ‘$fIntegralNatural’ - named item ‘divides’ - object ‘v1_@name_suffix@’: - arity: 1 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: <none> - object ‘pap_@name_suffix@’: - arity: 3 - literals: <none> - used items: <none> - named item ‘$fFoldableList’ - named item ‘any’ - named item ‘not’ - object ‘primes’: - arity: 0 - literals: - label ‘_hpc_tickboxes_Example_hpc’ - info table of ‘(:)’ - used items: - named item ‘primes2_@name_suffix@’ - named item ‘primes1_@name_suffix@’ - object ‘primes1_@name_suffix@’: - arity: 0 - literals: - label ‘_hpc_tickboxes_Example_hpc’ - word 2 - info table of ‘IS’ - used items: - named item ‘$fNumNatural’ - named item ‘fromInteger’ + named item ‘$fNumNatural’ + named item ‘fromInteger’ + named item ‘$fEnumNatural’ + named item ‘enumFrom’ + object ‘primes_sat_@name_suffix@’: + arity: 1 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: <none> + named item ‘filter’ + object ‘primes_sat_@name_suffix@’: + arity: 0 + literals: + label ‘_hpc_tickboxes_Example_hpc’ + word 2 + info table of ‘IS’ + used items: + named item ‘$fNumNatural’ + named item ‘fromInteger’ object ‘fibonaccisPtr’: arity: 0 literals: @@ -245,63 +243,59 @@ objects: arity: 0 literals: label ‘_hpc_tickboxes_Example_hpc’ used items: named item ‘fibonaccis’ - object ‘positiveFibonaccis1_@name_suffix@’: + object ‘fibonaccis’: arity: 0 literals: label ‘_hpc_tickboxes_Example_hpc’ info table of ‘(:)’ used items: - named item ‘positiveFibonaccis2_@name_suffix@’ - named item ‘positiveFibonaccis_@name_suffix@’ - object ‘positiveFibonaccis2_@name_suffix@’: - arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: - object ‘positiveFibonaccis2_sat_@name_suffix@’: - arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: named item ‘positiveFibonaccis1_@name_suffix@’ - object ‘positiveFibonaccis2_sat_@name_suffix@’: - arity: 0 + object ‘positiveFibonaccis_@name_suffix@’: + arity: 1 + literals: + label ‘_hpc_tickboxes_Example_hpc’ + info table of ‘(:)’ + used items: + object ‘positiveFibonaccis_fibonaccis_sat_@name_suffix@’: + arity: 1 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: + object ‘positiveFibonaccis_fibonaccis_sat_@name_suffix@’: + arity: 1 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: <none> + object ‘positiveFibonaccis_fibonaccis_sat_@name_suffix@’: + arity: 0 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: named item ‘fibonaccis’ + object ‘positiveFibonaccis_fibonaccis_sat_@name_suffix@’: + arity: 0 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: + named item ‘$fNumNatural’ + named item ‘(+)’ + named item ‘zipWith’ + object ‘positiveFibonaccis_fibonaccis_sat_@name_suffix@’: + arity: 0 + literals: + label ‘_hpc_tickboxes_Example_hpc’ + word 1 + info table of ‘IS’ + used items: + named item ‘$fNumNatural’ + named item ‘fromInteger’ + object ‘fibonaccis_sat_@name_suffix@’: + arity: 1 literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: named item ‘fibonaccis’ - object ‘positiveFibonaccis2_sat_@name_suffix@’: + used items: <none> + object ‘fibonaccis_sat_@name_suffix@’: arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ + literals: + label ‘_hpc_tickboxes_Example_hpc’ + word 0 + info table of ‘IS’ used items: named item ‘$fNumNatural’ - named item ‘(+)’ - named item ‘zipWith’ - object ‘fibonaccis’: - arity: 0 - literals: - label ‘_hpc_tickboxes_Example_hpc’ - info table of ‘(:)’ - used items: - named item ‘fibonaccis2_@name_suffix@’ - named item ‘fibonaccis1_@name_suffix@’ - object ‘fibonaccis2_@name_suffix@’: - arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: named item ‘positiveFibonaccis1_@name_suffix@’ - object ‘positiveFibonaccis_@name_suffix@’: - arity: 0 - literals: - label ‘_hpc_tickboxes_Example_hpc’ - word 1 - info table of ‘IS’ - used items: - named item ‘$fNumNatural’ - named item ‘fromInteger’ - object ‘fibonaccis1_@name_suffix@’: - arity: 0 - literals: - label ‘_hpc_tickboxes_Example_hpc’ - word 0 - info table of ‘IS’ - used items: - named item ‘$fNumNatural’ - named item ‘fromInteger’ + named item ‘fromInteger’ object ‘$dTypeable2_@name_suffix@’: arity: 0 literals: <none> View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9fdc56f3402665cecde73d79d6ae05d... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9fdc56f3402665cecde73d79d6ae05d... 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