[Git][ghc/ghc][wip/case-bndr-unf] 3 commits: Lambda and case binders have vanilla IdInfo (#27965)

Simon Peyton Jones pushed to branch wip/case-bndr-unf at Glasgow Haskell Compiler / GHC Commits: 04ba5bff by Simon Peyton Jones at 2026-10-26T17:38:26+00:00 Lambda and case binders have vanilla IdInfo (#27965) Lambda binders, case binders, and case-alternative binders should never have RULES, a (non-default) inline pragma, or a stable unfolding. See new Note [Core binder IdInfo invariants] in GHC.Core, which lays out the invariants. This patch * Makes Core Lint check the invariant, using the new predicate GHC.Types.Id.lamBndrInfoOK. * Fixes the desugarer, which violated it. For a strict binding let !x = rhs in body we generate let x = rhs in case x of x { DEFAULT -> body } re-using x (shadowed) as the case binder; see Note [Desugar Strict binds]. But the case binder inherited x's IdInfo, including, say, a NOINLINE pragma (e.g. `res1` in GHC.Internal.Control.Monad.ST.Lazy.Imp). Now GHC.HsToCore.Utils.seqVar gives the case binder vanilla IdInfo. This was not just a matter of taste. For example h fm s = let {-# NOINLINE res1 #-} !res1 = fm s !(f, s') = res1 in (f+1, s') The NOINLINE case binder becomes a NOINLINE alias `let res3 = res2`, which is never inlined, and survives (as a silly join point) into the final code. * Fixes the Simplifier, which could violate it when duplicating a StrictBind continuation, which makes a join point let x = <> in b ==> join j x = b in j <> If x has such IdInfo, we now use a fresh binder for the join point let x = <> in b ==> join j x' = let x = x' in b in j <> See (DSB1) in Note [Duplicating StrictBind]. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com> - - - - - 9e5f6245 by Simon Peyton Jones at 2026-10-26T17:38:26+00:00 Add varIsHNF, and use it in move_transit_vars `varIsHNF v` is the same as `exprIsHNF (Var v)`, but avoids building the Var only to take it apart. The (Var v) case of exprIsHNFlike now uses the shared varIsHNFlike, so the two cannot drift apart. In GHC.Core.Opt.WorkWrap.Utils.move_transit_vars we had the guard isUnliftedType var_ty || exprIsHNF (Var var) but exprIsHNF is already True of variables of (definitely) unlifted type, so the isUnliftedType test was redundant. Now it is just (varIsHNF var). No change in behaviour. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com> - - - - - 7eda54bc by Simon Peyton Jones at 2026-10-26T17:38:26+00:00 Use SimplClo for the argument of ApplyToVal This patch renames SimplSR to SimplClo (a "closure"), and uses it not only as the range of the Simplifier's substitution, but also as the argument of an ApplyToVal continuation. ApplyToVal used to have three fields sc_env :: StaticEnv sc_arg :: CoreExpr sc_cast :: MOutCoercion but now has just sc_dup :: DupFlag sc_arg :: SimplClo An un-simplified argument is (ContEx env arg mco), and an already-simplified one is (DoneEx arg _). See Note [The argument of ApplyToVal] in GHC.Core.Opt.Simplify.Utils. The main payoff is that, since the substitution maps an Id to a SimplClo, beta-reduction can substitute the argument for the lambda binder without further ado. Accordingly, preInlineUnconditionally is split into * preInlineLetUnconditionally, for let-bindings * preInlineBetaUnconditionally, for beta-redexes, which takes a SimplClo The latter omits some checks that cannot fire for lambda binders. Other notes * The new (ContEx env arg mco) form makes it easy to push a cast into an argument (mkCloCastMCo), whether or not it has been simplified. See Note [The MOutCoercion field of ContEx]. * `preInlineUnconditionally` gets split into two variants, one for let-bindings and one for beta-reduction (which takes a `SimplClo`). There is a little bit of duplication here, but not much. * Fixes #27962. The simplifier was previously dropping a cast when dealing with runRW#. The new `SimplClo` makes that bug much harder to allow. * Fixes #27963. contOutArgs, which supplies the arguments for Plan (BEFORE) rule matching, ignored the sc_cast field of ApplyToVal. So in (f |> co) n ==> f (n |> co1) -- co1 in sc_cast a rule for `f` saw `f n` rather than `f (n |> co1)`, and failed to match (the rule matcher checks the types of template variables). If f's unfolding is active, f may then be inlined, and the rule is lost for good. Now contOutArgs uses simplCloExpr, which includes the pending cast. Almost no change in behaviour, except for the #27963 bug-fix. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com> - - - - - 18 changed files: - + changelog.d/T27962 - + changelog.d/T27963 - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Types/Id.hs - + testsuite/tests/simplCore/should_compile/T27962.hs - + testsuite/tests/simplCore/should_compile/T27963.hs - + testsuite/tests/simplCore/should_compile/T27963.stderr - + testsuite/tests/simplCore/should_compile/T27965.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== changelog.d/T27962 ===================================== @@ -0,0 +1,7 @@ +section: compiler +issues: #27962 +mrs: !16829 +synopsis: + Fix a Lint error when using `runRW#` and `coerce` together +description: + Just an internal compiler bug, of long standing. ===================================== changelog.d/T27963 ===================================== @@ -0,0 +1,7 @@ +section: compiler +issues: #27963 +mrs: !16829 +synopsis: + Fix a rather obscure interaction of `coerce` and RULES +description: + A `coerce` could prevent a RULE firing. ===================================== compiler/GHC/Core.hs ===================================== @@ -1393,6 +1393,151 @@ same way as above, otherwise the analysis would not be conservative wrt. the lenient semantics (which includes the strict one). It is also much harder to explain and maintain, as it turned out. +Note [Core binder IdInfo invariants] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We allow the following IdInfo on different sorts of Core binders. +See the fields in GHC.Types.Id.Info.IdInfo: + +We classify binders into + * let-binders let x=rhs in body + * lambda binders (\x. e) + * case binders case e of x { ... } + * case-alternative binders case e of _ { K x y -> ... } + + Let Lambda Case/case-alt + --------------------------------------------- + Occurrence Yes Yes Yes + + InlinePrag Yes No No + Strictness (DmdSig) Yes No No + CPR info (CprSig) Yes No No + CAF Yes No No + Arity Yes No No + Call-arity Yes No No + Rules (RuleInfo) Yes No No + Unfolding Yes No(CBI1) evaldUnfolding only (CBI2) + Demand info Yes Yes Yes + One-shot No Yes No + ------------------------------------------------ + +The predicate `GHC.Types.Id.lamBndrInfoOK` checks the Lambda and Case columns +of this table (except one-shot info), and Core Lint applies it to every +non-let binder (`lintIdBndr`). + +Generally, lambda binders have only IdInfo that describes their /use/ +(e.g. occ-info, demand info) not their /definition/. See esp (CBI1). + +Case and case-alternative binders are similar because again they lack a definition, +and because they can /become/ a lambda binder when `mkDupableAlt` abstracts over them. + +Places that must take care to maintain these invariants (#27965): + +* The desugarer, when desugaring a strict binding let !x = rhs in body, + generates case x of x { DEFAULT -> body }; the case binder must not inherit + x's IdInfo. See `GHC.HsToCore.Utils.seqVar`. + +* `GHC.Core.Utils.bindNonRec` (used by `mkCoreLet`, and hence by the + Simplifier's `wrapFloats`), which turns let x = rhs in body into + case rhs of x { DEFAULT -> body } when `rhs` is unlifted and not + ok-for-speculation. Here `x` may well have a let-unfolding, e.g. one made + by `makeTrivial`. + +* `GHC.Core.Opt.SpecConstr.mkSeqs`, which builds case arg of arg' { DEFAULT -> rhs } + where `arg` may be an imported Id with an unfolding. + +All three use `GHC.Types.Id.mkCaseBndrFromLetBndr`. + +* The Simplifier's `simplNonRecE` does not use a StrictBind continuation for a + strict let-binding let x = rhs in body if `x` has RULES, a stable unfolding, + or a non-default inline pragma; for if it did, `mkDupableContWithDmds` might + turn `x` into the lambda binder of a join point. See `use_strict_bind`. + +(CBI1) Based on #17530 and #21496 we never attach unfoldings of any kind to lambda + binders, not even `evaldUnfolding`. + + It's just too easy for the call site to change and invalidate the unfolding. + E.g. the caller of the lambda drops a seq (e.g. because the lambda is strict + in its binder) which in turn makes the OtherCon[] unfolding a lie. So + unfoldings on lambda binders can never really be trusted when on lambda + binders if there is the chance of the call site to change. So it's easiest to + just never attach any to lambda binders to begin with, as well as stripping + them off if we e.g. float out an expression while abstracting over some + arguments. + +(CBI2) See Note [Evaluated-ness on case binders] + +(CBI3) Note that /occurrences/ may have IdInfo that is not present on the binder. + Notably, consider case e of r { Just x -> ..r...; Nothing -> ...r... } + The occurrence of `r` in the (Just x) branch will have an unfolding `Just x`, + and similarly in the `Nothing` branch. But the /binder/ of `r` has only + `evaldUnfolding` See Note [Evaluated-ness on case binders] + +Note [Evaluated-ness on case binders] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The binding site of an Id in case expression (case-binder or case alternative) may +carry an `OtherCon []` (aka `evaldUnfolding`). meaning "this variable is certainly +evaluated". Specifically: + +* Case binders are always evaluated. `GHC.Core.Opt.Simplify.Iteration.simplAlts` and + CorePrep add `evaldUnfolding` to every case binder. + +* Case-alternative binders for strict constructor fields + binders) + data T = MkT !Int Int + case x of MkT y z -> ... + `y` gets an evaldUnfolding. + + This is done by `GHC.Core.Utils.dataConRepFSInstPat` (used by the interface-file loader, + among others), `GHC.Core.SimpleOpt`, the Simplifier (`adjustFieldsIdInfo`), and + worker/wrapper (for the argument and CPR result binders it makes; + see Note [Record evaluated-ness in worker/wrapper] in GHC.Core.Opt.WorkWrap.Utils). + +Why is this information on the /binder/? Within the Simplifier it is not +needed there: in each case alternative the Simplifier adds a more precise +unfolding for the case binder (and evaluated-ness for strict-field binders) to +its in-scope set, and refreshes every occurrence from that. But many other +passes rebuild variable occurrences /from the binder/: substitution-based +passes (SimpleOpt, Specialise, SpecConstr, CSE), SetLevels/FloatOut, the binder +swap in the occurrence analyser, CoreTidy, and CorePrep. After such a pass, +an occurrence knows that the variable is evaluated only if the binder does. + +That knowledge is used, mainly via `exprIsHNF`/`varIsHNF` (not by +`exprOkForSpeculation`; see Note [exprOkForSpeculation and evaluated variables] +in GHC.Core.Utils), by: + +* CorePrep: deciding whether a let-binding is a value (allocate directly) or + a thunk, e.g. `let x = Box y` where `y` is a strict field. + See Note [Pin evaluatedness on floats] in GHC.CoreToStg.Prep. CorePrep runs + just after CoreTidy, which propagates binder IdInfo to occurrences. + +* SetLevels/FloatOut: floating single-alternative cases out of loops, when the + scrutinee is evaluated; see Note [Floating single-alternative cases] in + GHC.Core.Opt.SetLevels. Also the call-by-value marks given to abstracted + variables (`GHC.Types.Id.transferPolyIdInfo`). + +* Worker/wrapper: `move_transit_vars` avoids an unboxed 1-tuple for a single + evaluated transit variable (test T18109); and the CPR result binders of the + wrapper remain evaluated (tests T13077a, #13027). The latter matters because + unboxed-tuple alternatives take a fast path in the Simplifier's + `adjustFieldsIdInfo`, and so get evaluated-ness only from the binder. + +* SimpleOpt: eliminating a case on an evaluated variable, and `mkFieldSeqFloats`. + +* Minor heuristic uses: FloatIn (the late FloatIn runs after FloatOut and CSE + with no Simplifier in between) and occurrences created by CSE or the binder + swap, until the next Simplifier run. + +Core Lint does /not/ depend on this information. Nor does anything in STG or +tag inference. + +Removing the information from the binders would require these passes to track +evaluated-ness in an environment instead (as SpecConstr already does with its +ValueEnv), which they currently don't. So we allow an OtherCon unfolding (and +only that) on case binders and case-alternative binders: +see the table in Note [Core binder IdInfo invariants] + + + ************************************************************************ * * In/Out type synonyms @@ -1742,16 +1887,6 @@ floatBinders (FloatTick {}) = [] The @Unfolding@ type is declared here to avoid numerous loops -Note [Never put `OtherCon` unfoldings on lambda binders] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Based on #21496 we never attach unfoldings of any kind to lambda binders. -It's just too easy for the call site to change and invalidate the unfolding. -E.g. the caller of the lambda drops a seq (e.g. because the lambda is strict in it's binder) -which in turn makes the OtherCon[] unfolding a lie. -So unfoldings on lambda binders can never really be trusted when on lambda binders if there -is the chance of the call site to change. So it's easiest to just never attach any -to lambda binders to begin with, as well as stripping them off if we e.g. float out -and expression while abstracting over some arguments. -} -- | Records the /unfolding/ of an identifier, which is approximately the form the ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1858,6 +1858,15 @@ lintIdBndr top_lvl bind_site id thing_inside hang (text "Lambda binder" <+> quotes (ppr id) <+> text "has an unfolding") 2 (ppr unf) + -- Check that lambda, case, and case-alternative binders have + -- only the IdInfo permitted by the table in + -- Note [Core binder IdInfo invariants] in GHC.Core + ; checkL (is_let_bind || lamBndrInfoOK id) $ + hang (text "Non-let binder" <+> quotes (ppr id) + <+> text "has IdInfo that only a let-binder may have") + 2 (vcat [ text "Binding site:" <+> text (show_site bind_site) + , text "IdInfo:" <+> ppr (idInfo id) ]) + ; addLoc (IdTy id) (lintValueType id_ty) ; addInScopeId id thing_inside } @@ -1869,6 +1878,12 @@ lintIdBndr top_lvl bind_site id thing_inside LetBind -> True _ -> False + show_site :: BindingSite -> String + show_site LambdaBind = "lambda" + show_site CaseBind = "case binder" + show_site CasePatBind = "case alternative" + show_site LetBind = "let" + {- %************************************************************************ %* * ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -28,7 +28,7 @@ module GHC.Core.Opt.Simplify.Env ( SimplEnvIS, checkSimplEnvIS, pprBadSimplEnvIS, -- * Substitution results - SimplSR(..), substId, lookupRecBndr, + SimplClo(..), simplCloExpr, substId, lookupRecBndr, -- * Simplifying 'Id' binders simplNonRecBndr, simplNonRecJoinBndr, simplRecBndrs, simplRecJoinBndrs, @@ -61,7 +61,7 @@ import GHC.Core.Opt.Simplify.Monad import GHC.Core.Rules.Config ( RuleOpts(..) ) import GHC.Core import GHC.Core.Utils -import GHC.Core.Subst( substExprSC ) +import GHC.Core.Subst( substExpr ) import GHC.Core.Unfold import GHC.Core.TyCo.Subst (emptyIdSubstEnv, mkSubst) import GHC.Core.Multiplicity( Scaled(..), mkMultMul ) @@ -470,18 +470,26 @@ pprSimplEnv env ppr_one v | isId v = ppr v <+> ppr (idUnfolding v) | otherwise = ppr v -type SimplIdSubst = IdEnv SimplSR -- IdId |--> OutExpr +type SimplIdSubst = IdEnv SimplClo -- IdId |--> OutExpr -- See Note [Extending the IdSubstEnv] in GHC.Core.Subst --- | A substitution result. -data SimplSR +-- | A "closure" used in the Simplifier. It is used +-- * as the range of the substitution, 'SimplIdSubst' +-- * as the argument in an 'ApplyToVal' continuation +-- Roughly: either an (InExpr, StaticEnv) pair for an +-- as-yet-unsimplified expression +-- or an OutExpr, for an already-simplified one +-- It's a bit like thunk: we may "evaluate" the SimplClo in a ApplyToVal +-- and thereby transform it from `ContEx` to `DoneEx` +-- This happens in the `ApplyToVal` case of `mkDupableContWithDmds` +-- See Note [The argument of ApplyToVal] in GHC.Core.Opt.Simplify.Utils +data SimplClo = DoneEx OutExpr JoinPointHood -- If x :-> DoneEx e ja is in the SimplIdSubst -- then replace occurrences of x by e -- and ja = Just a <=> x is a join-point of arity a -- See Note [Join arity in SimplIdSubst] - | DoneId OutId -- If x :-> DoneId v is in the SimplIdSubst -- then replace occurrences of x by v @@ -490,11 +498,11 @@ data SimplSR | ContEx SimplEnv InExpr - MOutCoercion -- See Note [The sc_cast field of ApplyToVal] + MOutCoercion -- See Note [The MOutCoercion field of ContEx] -- If x :-> ContEx static_env e mco is in the SimplISubst -- then replace occurrences of x by (subst static_env e) |> mco -instance Outputable SimplSR where +instance Outputable SimplClo where ppr (DoneId v) = text "DoneId" <+> ppr v ppr (DoneEx e mj) = text "DoneEx" <> pp_mj <+> ppr e where @@ -637,7 +645,7 @@ reSimplifying :: SimplEnv -> Bool reSimplifying (SimplEnv { seInlineDepth = n }) = n>0 --------------------- -extendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv +extendIdSubst :: SimplEnv -> Id -> SimplClo -> SimplEnv extendIdSubst env@(SimplEnv {seIdSubst = subst}) var res = assertPpr (isId var && not (isCoVar var)) (ppr var) $ env { seIdSubst = extendVarEnv subst var res } @@ -1032,7 +1040,7 @@ So we want to look up the inner X.g_34 in the substitution, where we'll find that it has been substituted by b. (Or conceivably cloned.) -} -substId :: SimplEnv -> InId -> SimplSR +substId :: SimplEnv -> InId -> SimplClo -- Returns DoneEx only on a non-Var expression substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v = case lookupVarEnv ids v of -- Note [Global Ids in the substitution] @@ -1364,15 +1372,18 @@ getTCvSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seCvSubst = cv getFullSubst :: InScopeSet -> SimplEnv -> Subst getFullSubst in_scope (SimplEnv { seIdSubst = id_env, seTvSubst = tv_env, seCvSubst = cv_env }) - = mkSubst in_scope (mapVarEnv to_expr id_env) tv_env cv_env + = mkSubst in_scope (mapVarEnv (simplCloExpr in_scope) id_env) tv_env cv_env + +simplCloExpr :: InScopeSet -> SimplClo -> OutExpr +-- Turn a SimplClo into an OutExpr, by applying the substitution +-- (if any) and the pending cast (if any) +simplCloExpr _ (DoneEx e _) = e +simplCloExpr _ (DoneId v) = Var v +simplCloExpr in_scope (ContEx env e mco) = mkCastMCo e' mco where - to_expr :: SimplSR -> CoreExpr - -- A tiresome impedence-matcher - to_expr (DoneEx e _) = e - to_expr (DoneId v) = Var v - to_expr (ContEx env e mco) = mkCastMCo e' mco - where - e' = GHC.Core.Subst.substExprSC (getFullSubst in_scope env) e + e' = GHC.Core.Subst.substExpr (getFullSubst in_scope env) e + -- NB: we use substExpr, not substExprSC: we want to get the benefit of + -- knowing what is evaluated etc, via the in-scope set substTy :: HasDebugCallStack => SimplEnv -> Type -> Type substTy env ty = Type.substTy (getTCvSubst env) ty ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -285,8 +285,8 @@ simplRecOrTopPair :: SimplEnv -> SimplM (SimplFloats, SimplEnv) simplRecOrTopPair env bind_cxt old_bndr new_bndr rhs - | Just env' <- preInlineUnconditionally env (bindContextLevel bind_cxt) - old_bndr (UnSimplified env) rhs MRefl + | Just env' <- preInlineLetUnconditionally env (bindContextLevel bind_cxt) + old_bndr rhs env = {-#SCC "simplRecOrTopPair-pre-inline-uncond" #-} simplTrace "SimplBindr:inline-uncond1" (ppr old_bndr) $ do { tick (PreInlineUnconditionally old_bndr) @@ -1226,17 +1226,8 @@ simplExprF1 env (Tick t expr) cont = {-#SCC "simplTick" #-} simplTick env t exp simplExprF1 env (Coercion co) cont = {-#SCC "simplCoercionF" #-} simplCoercionF env co cont simplExprF1 env (Cast body co) cont - = do { co1 <- {-#SCC "simplCast-simplCoercion" #-} - simplCoercion env co - - ; let cont1 = {-#SCC "simplCast-addCoerce" #-} - if isReflCo co1 - then cont -- See Note [Optimising reflexivity] - else pushCast env co1 cont - -- True <=> co1 is optimised - - ; {-#SCC "simplCast-simplExprF" #-} - simplExprF env body cont1 } + = do { co1 <- simplCoercion env co + ; simplExprF env body (pushCast env co1 cont) } simplExprF1 env (App fun arg) cont = {-#SCC "simplExprF1-App" #-} case arg of @@ -1264,9 +1255,9 @@ simplExprF1 env (App fun arg) cont -- observed the quadratic behavior, so this extra entanglement -- seems not worthwhile. simplExprF env fun $ - ApplyToVal { sc_arg = arg, sc_env = UnSimplified env + ApplyToVal { sc_arg = ContEx env arg MRefl, sc_dup = NoDup , sc_hole_ty = substTy env (exprType fun) - , sc_cast = MRefl, sc_cont = cont } + , sc_cont = cont } simplExprF1 env expr@(Lam {}) cont = {-#SCC "simplExprF1-Lam" #-} @@ -1301,7 +1292,7 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont do { ty' <- simplType env ty ; simplExprF (extendTvSubst env bndr ty') body cont } - | Just env' <- preInlineUnconditionally env NotTopLevel bndr (UnSimplified env) rhs MRefl + | Just env' <- preInlineLetUnconditionally env NotTopLevel bndr rhs env -- Because of the let-can-float invariant, it's ok to -- inline freely, or to drop the binding if it is dead. = do { simplTrace "SimplBindr:inline-uncond2" (ppr bndr) $ @@ -1637,9 +1628,8 @@ rebuild_go env expr cont ApplyToTy { sc_arg_ty = ty, sc_cont = cont} -> rebuild_go env (App expr (Type ty)) cont - ApplyToVal { sc_arg = arg, sc_env = arg_se, sc_cast = arg_mco - , sc_cont = cont, sc_hole_ty = fun_ty } - -> do { arg' <- simplArg env Nothing fun_ty arg_se arg arg_mco + ApplyToVal { sc_arg = arg, sc_cont = cont, sc_hole_ty = fun_ty } + -> do { arg' <- simplArg env Nothing fun_ty arg ; rebuild_go env (App expr arg') cont } completeBindX :: SimplEnv @@ -1653,6 +1643,7 @@ completeBindX env from_what bndr rhs body cont | FromBeta arg_levity <- from_what , needsCaseBindingL arg_levity rhs -- Enforcing the let-can-float-invariant = do { (env1, bndr1) <- simplNonRecBndr env bndr -- Lambda binders don't have rules + -- See Note [Core binder IdInfo invariants] in GHC.Core ; (floats, expr') <- simplNonRecBody env1 from_what body cont -- Do not float floats past the Case binder below ; let expr'' = wrapFloats floats expr' @@ -1686,69 +1677,12 @@ completeBindX env from_what bndr rhs body cont ; let all_floats = rhs_floats `addFloats` bind_float `addFloats` body_floats ; return ( all_floats, body' ) } -{- -************************************************************************ + +{- ********************************************************************* * * -\subsection{Lambdas} + Arguments * * -************************************************************************ --} - -{- Note [Optimising reflexivity] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It's important (for compiler performance) to get rid of reflexivity as soon -as it appears. See #11735, #14737, and #15019. - -In particular, we want to behave well on - - * e |> co1 |> co2 - where the two happen to cancel out entirely. That is quite common; - e.g. a newtype wrapping and unwrapping cancel. - - - * (f |> co) @t1 @t2 ... @tn x1 .. xm - Here we will use pushCoTyArg and pushCoValArg successively, which - build up SelCo stacks. Silly to do that if co is reflexive. - -However, we don't want to call isReflexiveCo too much, because it uses -type equality which is expensive on big types (#14737 comment:7). - -A good compromise (determined experimentally) seems to be to call -isReflexiveCo - * when composing casts, and - * at the end - -In investigating this I saw missed opportunities for on-the-fly -coercion shrinkage. See #15090. - -Note [Avoid re-simplifying coercions] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In some benchmarks (with deeply nested cases) we successively push -casts onto the SimplCont. We don't want to call the coercion optimiser -on each successive composition -- that's at least quadratic. So: - -* The CastIt constructor in SimplCont has a `sc_opt :: Bool` flag to - record whether the coercion optimiser has been applied to the coercion. - -* In `simplCast`, when we see (Cast e co), we simplify `co` to get - an OutCoercion, and built a CastIt with sc_opt=True. - - Actually not quite: if we are simplifying the result of inlining an - unfolding (seInlineDepth > 0), then instead of /optimising/ it again, - just /substitute/ which is cheaper. See `simplCoercion`. - -* In `pushCast` if we combine this new coercion with an existing one, - we build a CastIt for (co1 ; co2) with sc_opt=False. - -* When unpacking a CastIt, in `rebuild`, we optimise the (presumably - composed) coercion if sc_opt=False; this is done by `optOutCoercion`. - -* When duplicating a continuation in `mkDupableContWithDmds`, before - duplicating a CastIt, optimise the coercion. Otherwise we'll end up - optimising it separately in the duplicate copies. - -* See also Note [The sc_cast field of ApplyToVal] in GHC.Core.Opt.Simplify.Utils. --} +********************************************************************* -} simplArg :: SimplEnvIS -- ^ Used only for its InScopeSet -> Maybe ArgInfo -- ^ Just <=> This arg `ai` occurs in an app @@ -1756,15 +1690,12 @@ simplArg :: SimplEnvIS -- ^ Used only for its InScopeSet -- how `f` uses `ai`, affecting the Stop -- continuation passed to 'simplExprC' -> OutType -- ^ Type of the function applied to this arg - -> StaticEnv -> CoreExpr -- ^ Expression with its static envt - -> MOutCoercion -- Wrap this around the result + -> SimplClo -- ^ The argument -> SimplM OutExpr -simplArg _ _ _ (Simplified {}) arg mco - = -- See Note [Avoid repeated simplification] - case mco of - MRefl -> return arg -- Vastly common case - MCo co -> return (mkCast arg co) -simplArg env mb_arg_info fun_ty (UnSimplified arg_se) arg mco +-- See Note [The argument of ApplyToVal] in GHC.Core.Opt.Simplify.Utils +simplArg _ _ _ (DoneEx arg _) = return arg -- See Note [Avoid repeated simplification] +simplArg _ _ _ (DoneId v) = return (Var v) +simplArg env mb_arg_info fun_ty (ContEx arg_se arg mco) = do { let arg_env' = arg_se `setInScopeFromE` env arg_ty = funArgTy fun_ty stop = case mb_arg_info of @@ -1773,13 +1704,12 @@ simplArg env mb_arg_info fun_ty (UnSimplified arg_se) arg mco cont = addCastMCo mco stop ; simplExprC arg_env' arg cont } -{- -************************************************************************ + +{- ********************************************************************* * * -\subsection{Lambdas} + Lambdas * * -************************************************************************ --} +********************************************************************* -} simplNonRecBody :: SimplEnv -> FromWhat -> InExpr -> SimplCont @@ -1806,13 +1736,9 @@ simpl_lam env bndr body (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = cont }) -- Value beta-reduction -- This works for /coercion/ lambdas too -simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_cast = arg_mco, sc_cont = cont +simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_cont = cont , sc_hole_ty = fun_ty}) - | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg_se arg arg_mco - , not (needsCaseBindingL arg_levity arg) - -- Ok to test arg::InExpr in needsCaseBinding because - -- exprOkForSpeculation is stable under simplification + | Just env' <- preInlineBetaUnconditionally env arg_levity bndr arg = simplTrace "SimplBindr:inline-uncond3" (ppr bndr <+> text ":=" <+> ppr arg) $ do { tick (BetaReduction bndr) @@ -1823,14 +1749,14 @@ simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se = do { tick (BetaReduction bndr) ; let from_what = FromBeta arg_levity - ; case (arg_se, arg_mco) of - (UnSimplified arg_env, MRefl) + ; case arg of + ContEx arg_env arg_expr MRefl -- Optimisation: when there is no wrapping coercion use simplNonRecE -- so that the clever floating out of let-bindings can take place -- in this round of the Simplifier - -> simplNonRecE env from_what bndr (arg, arg_env) body cont + -> simplNonRecE env from_what bndr (arg_expr, arg_env) body cont - _ -> do { arg' <- simplArg env Nothing fun_ty arg_se arg arg_mco + _ -> do { arg' <- simplArg env Nothing fun_ty arg ; completeBindX env from_what bndr arg' body cont } } where @@ -1869,7 +1795,7 @@ simplLamBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr) -- could have a stable unfolding; -- see Historical Note [Case binders and join points] -- But now it is much simpler! We now only remove unfoldings. --- See Note [Never put `OtherCon` unfoldings on lambda binders] +-- See (CBI1) in Note [Core binder IdInfo invariants] simplLamBndr env bndr = simplBinder env (zapIdUnfolding bndr) simplLamBndrs :: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr]) @@ -1903,7 +1829,7 @@ simplNonRecE :: HasDebugCallStack simplNonRecE env from_what bndr (rhs, rhs_se) body cont | assert (isId bndr && not (isJoinId bndr) ) $ - is_strict_bind + use_strict_bind = -- Evaluate RHS strictly simplExprF (rhs_se `setInScopeFromE` env) rhs (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what @@ -1918,14 +1844,31 @@ simplNonRecE env from_what bndr (rhs, rhs_se) body cont ; return (floats1 `addFloats` floats2, expr') } where - is_strict_bind = case from_what of - FromBeta Unlifted -> True + info = idInfo bndr + + use_strict_bind -- If we are coming from a beta-reduction (FromBeta) we must - -- establish the let-can-float invariant, so go via StrictBind + -- establish the let-can-float invariant, so we must go via StrictBind -- If not, the invariant holds already, and it's optional. + | FromBeta Unlifted <- from_what + = True + + -- Not if the demand is non-strict + | not (isStrUsedDmd (demandInfo info)) + = False + + -- Not if case-of-case is off + -- See (SB1) in Note [StrictBind] + | not (seCaseCase env) + = False + + -- Not for things with RULES or INLINE or NOINLINE + -- See (SB3) in Note [StrictBind] + | FromLet <- from_what + , not (lamBndrInfoOK bndr) + = False - -- (FromBeta Lifted) or FromLet: look at the demand info - _ -> seCaseCase env && isStrUsedDmd (idDemandInfo bndr) + | otherwise = True ------------------ @@ -2262,11 +2205,14 @@ simplOutId env fun cont | fun `hasKey` runRWKey , ApplyToTy { sc_cont = cont1 } <- cont , ApplyToTy { sc_cont = cont2, sc_arg_ty = hole_ty } <- cont1 - , ApplyToVal { sc_cont = cont3, sc_arg = arg, sc_cast = arg_mco - , sc_env = arg_se, sc_hole_ty = fun_ty } <- cont2 + , ApplyToVal { sc_cont = cont3, sc_arg = arg_clo, sc_hole_ty = fun_ty } <- cont2 -- Do this even if (contIsStop cont), or if seCaseCase is off. -- See Note [No eta-expansion in runRW#] - = do { let (_saf,arg_env) = mkAltEnv env arg_se + = do { let (arg_env, arg, arg_mco) + = case arg_clo of + ContEx se e mco -> (se `setInScopeFromE` env, e, mco) + DoneEx e _ -> (env, e, MRefl) + DoneId v -> (env, Var v, MRefl) overall_res_ty = contResultType cont3 -- hole_ty is the type of the current runRW# application @@ -2281,23 +2227,32 @@ simplOutId env fun cont -- * If we don't do this we get a beta-redex every time, so the -- simplifier keeps doing more iterations. -- * Even more important: see Note [No eta-expansion in runRW#] + -- + -- But only if there is no pending cast on the argument (#27962); + -- if there is, the general case below deals with it properly ; arg' <- case arg of - Lam s body -> do { (env', s') <- simplBinder arg_env s - ; body' <- simplExprC env' body inner_cont - ; return (Lam s' body') } - -- Important: do not try to eta-expand this lambda - -- See Note [No eta-expansion in runRW#] + Lam s body + | MRefl <- arg_mco + -> do { (env', s') <- simplBinder arg_env s + ; body' <- simplExprC env' body inner_cont + ; return (Lam s' body') } + -- Important: do not try to eta-expand this lambda + -- See Note [No eta-expansion in runRW#] _ -> do { s' <- newId (fsLit "s") ManyTy realWorldStatePrimTy ; let (m,_,_) = splitFunTy fun_ty env' = arg_env `addNewInScopeIds` [s'] hole_ty = mkVisFunTy m realWorldStatePrimTy new_runrw_res_ty cont' = pushCastMCo env' arg_mco $ - ApplyToVal { sc_arg = Var s', sc_cast = MRefl - , sc_env = Simplified OkDup + ApplyToVal { sc_arg = DoneId s' + , sc_dup = dup , sc_cont = inner_cont , sc_hole_ty = hole_ty } -- cont' applies to s', then K + -- The argument (Var s') is small, but inner_cont may not be + -- dupable; see (AV2) in Note [The argument of ApplyToVal] + dup | contIsDupable inner_cont = OkDup + | otherwise = NoDup ; body' <- simplExprC env' arg cont' ; return (Lam s' body') } @@ -2364,13 +2319,12 @@ rebuildCall env info (ApplyToTy { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_c ---------- Simplify value arguments -------------------- rebuildCall env fun_info - (ApplyToVal { sc_arg = arg, sc_env = arg_se, sc_cast = arg_mco - , sc_hole_ty = fun_ty, sc_cont = cont }) - | UnSimplified arg_env <- arg_se + (ApplyToVal { sc_arg = arg, sc_hole_ty = fun_ty, sc_cont = cont }) + | ContEx arg_env arg_expr arg_mco <- arg , isStrictArgInfo fun_info -- Strict arguments , seCaseCase env -- But only when case-of-case is on. -- See Note [Case-of-case and full laziness] - = simplExprF (arg_env `setInScopeFromE` env) arg $ + = simplExprF (arg_env `setInScopeFromE` env) arg_expr $ addCastMCo arg_mco $ StrictArg { sc_fun = fun_info, sc_fun_ty = fun_ty , sc_dup = NoDup @@ -2382,7 +2336,7 @@ rebuildCall env fun_info -- There is no benefit (unlike in a let-binding), and we'd -- have to be very careful about bogus strictness through -- floating a demanded let. - = do { arg' <- simplArg env (Just fun_info) fun_ty arg_se arg arg_mco + = do { arg' <- simplArg env (Just fun_info) fun_ty arg ; rebuildCall env (addValArgTo fun_info arg' fun_ty) cont } ---------- No further useful info, revert to generic rebuild ------------ @@ -2530,11 +2484,11 @@ Then * We simplify BIG before trying the rule; but the rule does not fire (forcing this simplification is why we have the RULE in this example) * We inline f = \x. g x, in `simpl_lam` - * So if `simpl_lam` did preInlineUnconditionally we get (g BIG) + * So if `simpl_lam` did preInlineBetaUnconditionally we get (g BIG) * Now if g has a RULE we'll simplify BIG again, and this whole thing can iterate. * However, if `f` did not have a RULE, so that BIG has /not/ already been - simplified, we /want/ to do preInlineUnconditionally in simpl_lam. + simplified, we /want/ to do preInlineBetaUnconditionally in simpl_lam. So we go to some effort to avoid repeatedly simplifying the same thing. Suppose we are in the Plan (AFTER) case of rule application, for a rule @@ -2543,8 +2497,9 @@ and a call f (e1,e2) Then: -* The (sc_env :: StaticEnv) field of ApplyToVal records if the argument - has been evaluated. See Note [StaticEnv] in GHC.Core.Opt.Simplify.Utils. +* The (sc_arg :: SimplClo) field of ApplyToVal records if the argument + has been simplified: it is a DoneEx if so, and a ContEx if not. + See Note [The argument of ApplyToVal] in GHC.Core.Opt.Simplify.Utils. * The rule fires returning RuleMatch { rm_rhs = (\x y. ...x..), rm_args = [ e1, e2 ] } @@ -2557,17 +2512,17 @@ Then: is the reason that `RuleMatch` separates the two. * `fireRuleAFTER` uses `pushOutArgs` to push [ e1, e2 ] back onto the - continuation with sc_env=Simplified NoDup. + continuation as (DoneEx e1) and (DoneEx e2). * Beta-reduction fires (in `simpl_lam`) for the \x. * Suppose `x` occurs many times. Then we want to behave like `let x=e1 in ..`, - but we use `simplArg`, which in turn uses that `sc_env` flag to avoid + but we use `simplArg`, which in turn uses the DoneEx to avoid re-simplifying `e1`. * Suppose `x` occurs just once or not at all; then the call to - `preInlineUnconditionally` in `simpl_lam` will fire, and extend the - substitution with + `preInlineBetaUnconditionally` in `simpl_lam` will fire, and extend the + substitution with the very same SimplClo x :-> DoneEx e1 * At the /occurrence/ of `x`, the function `simplInId` calls `simplOutExpr` @@ -2774,8 +2729,7 @@ trySeqRules in_env scrut rhs cont , ValArg { as_arg = no_cast_scrut , as_dmd = seqDmd , as_hole_ty = res3_ty } ] - rule_cont = ApplyToVal { sc_env = UnSimplified in_env, sc_arg = rhs - , sc_cast = MRefl + rule_cont = ApplyToVal { sc_arg = ContEx in_env rhs MRefl, sc_dup = NoDup , sc_cont = cont, sc_hole_ty = res4_ty } out_args = [Type rhs_rep, Type scrut_ty, Type rhs_ty, no_cast_scrut] @@ -3420,6 +3374,7 @@ simplAlts (saf,env0) scrut case_bndr alts cont' ; let case_bndr2 = case_bndr1 `setIdUnfolding` evaldUnfolding env2 = modifyInScope env1 case_bndr2 -- See Note [Case binder evaluated-ness] + -- and Note [Evaluated-ness on case binders] in GHC.Core fam_envs = seFamEnvs env0 ; (alt_env', scrut', case_bndr') <- improveSeq fam_envs (saf,env2) scrut @@ -3879,8 +3834,8 @@ knownCon env scrut dc dc_args case_bndr alt_bndrs rhs cont return ( emptyFloats env , extendIdSubst env case_bndr (DoneEx scrut NotJoinPoint)) - | Just env' <- preInlineUnconditionally env NotTopLevel case_bndr - (UnSimplified env) con_app MRefl + | Just env' <- preInlineLetUnconditionally env NotTopLevel case_bndr + con_app env = return (emptyFloats env', env') | otherwise @@ -4043,7 +3998,7 @@ mkDupableContWithDmds env dmds (TickIt t cont) mkDupableContWithDmds env _ cont1@(StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what , sc_env = se, sc_cont = cont}) --- See Note [Duplicating StrictBind] +-- See (SB2) in Note [StrictBind] -- K[ let x = <> in b ] --> join j x = K[ b ] -- j <> = do { let sb_env = case se of @@ -4060,7 +4015,10 @@ mkDupableContWithDmds env _ ; let join_body = wrapFloats floats1 join_inner res_ty = contResultType cont - ; mkDupableStrictBind env bndr' join_body res_ty } + -- bndr' is about to become a lambda binder, so it must have suitable + -- IdInfo; simplNonRecE ensures this. See Note [Core binder IdInfo invariants] + ; assertPpr (lamBndrInfoOK bndr') (ppr bndr' $$ ppr (idInfo bndr')) $ + mkDupableStrictBind env bndr' join_body res_ty } mkDupableContWithDmds env _ (StrictArg { sc_fun = fun, sc_cont = cont @@ -4111,8 +4069,7 @@ mkDupableContWithDmds env dmds , sc_arg_ty = arg_ty, sc_hole_ty = hole_ty }) } mkDupableContWithDmds env dmds - (ApplyToVal { sc_arg = arg, sc_env = se, sc_cast = arg_mco - , sc_cont = cont, sc_hole_ty = hole_ty }) + (ApplyToVal { sc_arg = arg, sc_cont = cont, sc_hole_ty = hole_ty }) = -- e.g. [...hole...] (...arg...) -- ==> -- let a = ...arg... @@ -4124,12 +4081,12 @@ mkDupableContWithDmds env dmds expectNonEmpty dmds ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 - ; arg' <- simplArg env' Nothing hole_ty se arg arg_mco + ; arg' <- simplArg env' Nothing hole_ty arg ; (let_floats2, triv_arg) <- makeTrivial env' NotTopLevel dmd (fsLit "karg") arg' ; let all_floats = floats1 `addLetFloats` let_floats2 ; return ( all_floats - , ApplyToVal { sc_arg = triv_arg, sc_env = Simplified OkDup - , sc_cast = MRefl, sc_cont = cont', sc_hole_ty = hole_ty }) } + , ApplyToVal { sc_arg = DoneEx triv_arg NotJoinPoint, sc_dup = OkDup + , sc_cont = cont', sc_hole_ty = hole_ty }) } mkDupableContWithDmds env _ (Select { sc_bndr = case_bndr, sc_alts = alts, sc_env = se, sc_cont = cont }) @@ -4253,7 +4210,9 @@ mkDupableAlt _env case_bndr jfloats (Alt con alt_bndrs alt_rhs_in) | otherwise = v -- No lambda binder has an unfolding, but (currently) case binders can, - -- so we must zap them here. + -- so we must zap them here. But case binders never have a pragma, + -- stable unfolding or RULES, so there is no need to zap those. + -- See Note [Core binder IdInfo invariants] in GHC.Core join_rhs = mkLams (map zapIdUnfolding final_bndrs) rhs_with_seqs ; join_bndr <- newJoinId filtered_binders rhs_ty' @@ -4569,7 +4528,7 @@ There are two ways to make it duplicable. ; False -> jump $j r2 } Notice that Plan B is very like the way we handle strict bindings; - see Note [Duplicating StrictBind]. And Plan B is exactly what we'd + see Note [StrictBind]. And Plan B is exactly what we'd get if we turned use a case expression to evaluate the strict arg: case (case x of { True -> r1; False -> r2 }) of @@ -4642,23 +4601,54 @@ Note [Inline small things to avoid creating a thunk] in Simplify.Utils. But if we do inline them, the entire process will repeat -- back to exponential behaviour. -So we are careful to keep the demand-info on a2 and a3. Then they'll -be /strict/ let-bindings, which will be dealt with by StrictBind. -That's why contIsDupableWithDmds is careful to propagage demand -info to the auxiliary bindings it creates. See the Demand argument -to makeTrivial. - -Note [Duplicating StrictBind] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We make a StrictBind duplicable in a very similar way to -that for case expressions. After all, - let x* = e in b is similar to case e of x -> b - -So we potentially make a join-point for the body, thus: - let x = <> in b ==> join j x = b - in j <> - -Just like StrictArg in fact -- and indeed they share code. +So we are careful to keep the demand-info on a2 and a3. Then they'll be +/strict/ let-bindings, which will be dealt with by `StrictBind` (see +Note [StrictBind]). That's why `contIsDupableWithDmds` is careful to +propagate demand info to the auxiliary bindings it creates. See the +`Demand` argument to `makeTrivial`. + +Note [StrictBind] +~~~~~~~~~~~~~~~~~ +We use StrictBind when we fine + let x! = rhs in body +where the `x` is definitely demanded in body. When this happens we can +float out case-expressions etc from inside `e`; e.g. + let { x! = case a of (p,q) -> rhs } in b +--> + case a of (p,q) -> let x! = rhs in b + +We simplify `rhs` with a StrictBind continuation that continues with +`body` + +(SB1) We only use StrictBind when case-of-case is on: + see Note [Case-of-case and full laziness] + +(SB2) We make a StrictBind /duplicable/ in a very similar way to + that for case expressions. After all, + let x! = e in b is similar to case e of x -> b + + So we potentially make a join-point for the body, thus: + let x = <> in b ==> join j x = b + in j <> + + Just like StrictArg in fact -- and indeed they share code. + +(SB3) We do not do use StrictBind if the binder `x` has: + * A stable unfolding + * RULES + * An inlining activation that is not always active. + Why not? Because these things won't survive if we duplicate the join point. + For example: + let {-# NOINLINE x #-} + x! = case y of { ... } + in blah + If we make a join point j x = blah, we have nowhere convenient + to put that NOINLINE. Ditto INLINE or RULES. It's very unusual, + so no harm in simply not using StrictBind. But it does happen; + one example is this, in the Applicative (ST s) instance in + GHC.Internal.Control.Monad.St.Lazy.Imp + {-# NOINLINE res1 #-} + !res1 = unST fm s Note [Join point abstraction] Historical note ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -12,7 +12,8 @@ module GHC.Core.Opt.Simplify.Utils ( tryEtaExpandRhs, wantEtaExpansion, -- Inlining, - preInlineUnconditionally, postInlineUnconditionally, + preInlineLetUnconditionally, preInlineBetaUnconditionally, + postInlineUnconditionally, activeRule, getUnfoldingInRuleMatch, updModeForStableUnfoldings, updModeForRuleLHS, updModeForRuleRHS, @@ -174,16 +175,14 @@ data SimplCont -- Invariant: never an identity coercion , sc_opt :: Bool -- True <=> sc_co has had optCoercion applied to it -- See Note [Avoid re-simplifying coercions] - -- in GHC.Core.Opt.Simplify.Iteration , sc_cont :: SimplCont } | ApplyToVal -- (ApplyToVal arg K)[e] = K[ e arg ] { sc_hole_ty :: OutType -- Type of the function, presumably (forall a. blah) -- See Note [The hole type in ApplyToTy] - , sc_env :: StaticEnv -- See Note [StaticEnv] - , sc_arg :: CoreExpr -- The argument - , sc_cast :: MOutCoercion -- Wrap this OutCoercion around the (simplified) argument - -- See Note [The sc_cast field of ApplyToVal] + , sc_dup :: DupFlag -- See Note [The argument of ApplyToVal] + , sc_arg :: SimplClo -- The argument + -- Invariant: if sc_arg is a ContEx, then sc_dup = NoDup , sc_cont :: SimplCont } | ApplyToTy -- (ApplyToTy ty K)[e] = K[ e ty ] @@ -201,6 +200,7 @@ data SimplCont -- The two strict forms have no DupFlag, because we never duplicate them | StrictBind -- (StrictBind x b K)[e] = let x = e in K[b] -- or, equivalently, = K[ (\x.b) e ] + -- See Note [StrictBind] in GHC.Core.Opt.Simplify.Iteration { sc_from :: FromWhat , sc_env :: StaticEnv -- See Note [StaticEnv] -- The sc_env in StrictBind is never (Simplified NoDup) @@ -252,49 +252,85 @@ perhapsSubstTy (UnSimplified env) ty = substTy env ty {- Note [StaticEnv] ~~~~~~~~~~~~~~~~~~~ -Consider ApplyToVal, which has - sc_env :: StaticEnv - sc_arg :: CoreExpr -Initially, `sc_arg` is an un-simplified InExpr, and `sc_env` is (UnSimplified env), -where `env` gives meaning to the free variables of `sc_arg`; in particular, `env` -may have substitutions that must apply to the argument. - -But sometimes we simplify the argument, and in that case, `sc_arg` is an OutExpr, -the simplified argument, and `sc_env` is (Simplified NoDup) or (Simplified OkDup). -The former is the safe, conservative option, but in `mkDupableCont` we want to make -the continuation duplicable, so we make the argument small and tag it with -(Simplified OkDup). - -We later simplify the argument, e.g. in `simplArg`. Then - * If sc_env is Simplified, it's a no-op - * If sc_env is (UnSimplified arg_env) we simplify `sc_arg` with - - Its captured envt `arg_env` +Consider Select, which has + sc_env :: StaticEnv + sc_bndr :: Id + sc_alts :: [CoreAlt] +Initially, `sc_bndr` and `sc_alts` are un-simplified InThings, and `sc_env` is +(UnSimplified env), where `env` gives meaning to their free variables; in +particular, `env` may have substitutions that must apply to them. + +But sometimes (notably in `mkDupableCont`) we simplify them, and in that case +`sc_bndr` and `sc_alts` are OutThings, and `sc_env` is (Simplified dup). + +When we finally simplify the alternatives (see `mkAltEnv`) + * If sc_env is Simplified, there is nothing to do + * If sc_env is (UnSimplified alt_env) we simplify them with + - Their captured envt `alt_env` - but overriding its InScopeSet with the larger one at the simplification point. Why override the InScopeSet? Example: - (let y = ey in f) ex - By the time we simplify ex, 'y' will be in scope. - All this is done in `simplArg`. + case (let y = ey in f) of alts + By the time we simplify alts, 'y' will be in scope. Note that: * In the Simplified case there is no environment, because the substitution has already been applied. -* We say sc_arg :: CoreExpr, rather than sc_arg :: InExpr or sc_arg :: OutExpr, - because whether it is InExpr or OutExpr depends on `sc_env` +* We say sc_alts :: [CoreAlt], rather than [InAlt] or [OutAlt], + because whether they are InAlts or OutAlts depends on `sc_env` + +* Same deal for StrictBind, where the StaticEnv scopes over sc_bndr and sc_body. -* Same deal for Select, and StrictBind, but the StaticEnv scopes over - * sc_bndr and sc_alts (for Select) - * sc_bndr and sc_body (for StrictBind) +* ApplyToVal is similar, but simpler: it uses a SimplClo instead. + See Note [The argument of ApplyToVal]. -* Even though the InScopeSet of an (UnSimplified se) is overridden in `simplArg`, - that InScopeSet is not irrelevant: it should include all the free vars of - applying the substitution to the InExpr. Reason: contHoleType uses perhapsSubstTy - to apply the substitution to the expression, and that (rightly) gives ASSERT - failures if the InScopeSet isn't big enough. +* Even though the InScopeSet of an (UnSimplified se) is overridden, that + InScopeSet is not irrelevant: it should include all the free vars of + applying the substitution to the InThing. Reason: contHoleType uses + perhapsSubstTy to apply the substitution to the binder, and that + (rightly) gives ASSERT failures if the InScopeSet isn't big enough. (SE1) If dup = OkToDup, then continuation k is also ok-to-dup + +Note [The argument of ApplyToVal] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +ApplyToVal has + sc_dup :: DupFlag + sc_arg :: SimplClo + +Initially, `sc_arg` is (ContEx env arg MRefl), where `arg` is the un-simplified +InExpr, and `env` gives meaning to the free variables of `arg`; in particular, +`env` may have substitutions that must apply to the argument. + +But sometimes we simplify the argument, and in that case, `sc_arg` is +(DoneEx arg' NotJoinPoint), where `arg'` is the simplified argument. + +The `sc_dup` flag says whether the continuation can be duplicated. NoDup is +the safe, conservative option, but in `mkDupableCont` we want to make the +continuation duplicable, so we make the argument small (and hence a DoneEx) +and set `sc_dup` to OkDup. Invariants: + + (AV1) If `sc_arg` is a ContEx, then `sc_dup` is NoDup. + + (AV2) If `sc_dup` is OkDup then `sc_cont` is also ok-to-dup; see (SE1) + in Note [StaticEnv]. + +We later simplify the argument, in `simplArg`. Then + * If `sc_arg` is a DoneEx (or DoneId), it's a no-op + * If `sc_arg` is (ContEx arg_env arg mco) we simplify `arg` with + - Its captured envt `arg_env` + - but overriding its InScopeSet with the larger one at the + simplification point. + Why override the InScopeSet? Example: + (let y = ey in f) ex + By the time we simplify ex, 'y' will be in scope. + Then we wrap the cast `mco` around the result. + See Note [The MOutCoercion field of ContEx]. + +Using a SimplClo for the argument means that it can be substituted for a lambda +binder, in `preInlineBetaUnconditionally`, without further ado. -} instance Outputable DupFlag where @@ -312,9 +348,9 @@ instance Outputable SimplCont where = (text "TickIt" <+> ppr t) $$ ppr cont ppr (ApplyToTy { sc_arg_ty = ty, sc_cont = cont }) = (text "ApplyToTy" <+> pprParendType ty) $$ ppr cont - ppr (ApplyToVal { sc_arg = arg, sc_env = env, sc_cont = cont, sc_hole_ty = hole_ty }) - = (hang (text "ApplyToVal" <> braces (ppr env) <+> text "hole-ty:" <+> pprParendType hole_ty) - 2 (pprParendExpr arg)) + ppr (ApplyToVal { sc_arg = arg, sc_dup = dup, sc_cont = cont, sc_hole_ty = hole_ty }) + = (hang (text "ApplyToVal" <> braces (ppr dup) <+> text "hole-ty:" <+> pprParendType hole_ty) + 2 (ppr arg)) $$ ppr cont ppr (StrictBind { sc_bndr = b, sc_cont = cont }) = (text "StrictBind" <+> ppr b) $$ ppr cont @@ -433,8 +469,8 @@ pushOutArgs fun_ty (arg:args) cont = ApplyToTy { sc_hole_ty = fun_ty, sc_arg_ty = ty , sc_cont = pushOutArgs (piResultTy fun_ty ty) args cont } | otherwise - = ApplyToVal { sc_hole_ty = fun_ty, sc_cast = MRefl - , sc_arg = arg, sc_env = Simplified NoDup + = ApplyToVal { sc_hole_ty = fun_ty + , sc_arg = DoneEx arg NotJoinPoint, sc_dup = NoDup , sc_cont = pushOutArgs (funResultTy fun_ty) args cont} pushArgSpecs :: [ArgSpec] -- In normal, forward order @@ -445,7 +481,7 @@ pushArgSpec :: ArgSpec -> SimplCont -> SimplCont pushArgSpec (TyArg { as_arg_ty = arg_ty, as_hole_ty = hole_ty }) cont = ApplyToTy { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_cont = cont } pushArgSpec (ValArg { as_arg = arg, as_hole_ty = hole_ty }) cont - = ApplyToVal { sc_arg = arg, sc_env = Simplified NoDup, sc_cast = MRefl + = ApplyToVal { sc_arg = DoneEx arg NotJoinPoint, sc_dup = NoDup , sc_hole_ty = hole_ty, sc_cont = cont } argSpecArg :: ArgSpec -> OutExpr @@ -496,7 +532,12 @@ contIsStop _ = False contIsDupable :: SimplCont -> Bool contIsDupable (Stop {}) = True contIsDupable (ApplyToTy { sc_cont = k }) = contIsDupable k -contIsDupable (ApplyToVal { sc_env = se }) = okToDupSE se -- See (SE1) in Note [StaticEnv] +contIsDupable (ApplyToVal { sc_dup = dup, sc_arg = arg }) + = assertPpr (not (okToDup dup && is_cont_ex arg)) (ppr arg) $ + okToDup dup -- See (AV1,AV2) in Note [The argument of ApplyToVal] + where + is_cont_ex (ContEx {}) = True + is_cont_ex _ = False contIsDupable (Select { sc_env = se }) = okToDupSE se -- ...ditto... contIsDupable (StrictBind { sc_env = se }) = okToDupSE se -- ...ditto... contIsDupable (StrictArg { sc_dup = dup }) = okToDup dup -- ...ditto... @@ -605,8 +646,8 @@ contArgs env cont lone (CastIt {}) = False -- stops it being "lone" lone _ = True - go args (ApplyToVal { sc_arg = arg, sc_env = se, sc_cont = k }) - = go (interestingArg env se arg : args) k + go args (ApplyToVal { sc_arg = arg, sc_cont = k }) + = go (interestingArg env arg : args) k go args (ApplyToTy { sc_cont = k }) = go args k go args (CastIt { sc_cont = k }) = go args k go args k = (False, reverse args, k) @@ -621,15 +662,13 @@ contOutArgs env cont go (ApplyToTy { sc_arg_ty = ty, sc_cont = cont }) = Type ty : go cont - go (ApplyToVal { sc_arg = arg, sc_env = se, sc_cont = cont }) - = case se of - Simplified {} -> arg : go cont - UnSimplified env -> GHC.Core.Subst.substExpr (getFullSubst in_scope env) arg : go cont - -- Make sure we apply the static environment `sc_env` as a substitution + go (ApplyToVal { sc_arg = arg, sc_cont = cont }) + = simplCloExpr in_scope arg : go cont + -- Make sure we apply the static environment of a ContEx as a substitution -- to get an OutExpr. See (BF1) in Note [tryRules: plan (BEFORE)] -- in GHC.Core.Opt.Simplify.Iteration - -- NB: we use substExpr, not substExprSC: we want to get the benefit of - -- knowing what is evaluated etc, via the in-scope set + -- simplCloExpr also wraps the pending cast (if any) around the argument; + -- omitting it can make a rule fail to match (#27963) -- No more arguments go _ = [] @@ -826,23 +865,86 @@ make use of the strictness info for the function. * * ********************************************************************* -} -{- Note [The sc_cast field of ApplyToVal] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [The MOutCoercion field of ContEx] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the `ApplyToVal` case of `pushCast` we want to push an `OutCoercion` into the -argument. But the argument may or may not have been simplified (see Note [StaticEnv]) -so we definitely can't just wrap the cast around the argument. Instead we store it -in the `sc_cast` field -- this is the whole reason for the `sc_cast` field. +argument. But the argument may or may not have been simplified (see Note [The +argument of ApplyToVal]): + +* If it has been simplified, it is (DoneEx arg' _), and we can simply wrap the + cast around `arg'`. + +* If it has not, it is (ContEx env arg mco), and we definitely can't just wrap + the (Out)cast around the InExpr `arg`. Instead we compose it with `mco` -- + this is the whole reason for the MOutCoercion field of `ContEx`. + +All this is done by `mkCloCastMCo`. We deal with that pending cast mainly in `simplArg`. But we /also/ sometimes want to substitute that argument for a lambda-binder, in -`preInlineUnconditionally`. So we also have to put that pending cast into -`ContEx`; hence the MOutCoercion field of `ContEx`. Then we deal with it -appropriately when /applying/ the substitution in `simplInId`. +`preInlineBetaUnconditionally`; and since the substitution maps an Id to a SimplClo, +the pending cast comes along for free. Then we deal with it appropriately when +/applying/ the substitution in `simplInId`. + +Note [Optimising reflexivity] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It's important (for compiler performance) to get rid of reflexivity as soon +as it appears. See #11735, #14737, and #15019. + +In particular, we want to behave well on + + * e |> co1 |> co2 + where the two happen to cancel out entirely. That is quite common; + e.g. a newtype wrapping and unwrapping cancel. + + + * (f |> co) @t1 @t2 ... @tn x1 .. xm + Here we will use pushCoTyArg and pushCoValArg successively, which + build up SelCo stacks. Silly to do that if co is reflexive. + +However, we don't want to call isReflexiveCo too much, because it uses +type equality which is expensive on big types (#14737 comment:7). + +A good compromise (determined experimentally) seems to be to call +isReflexiveCo + * when composing casts, and + * at the end + +In investigating this I saw missed opportunities for on-the-fly +coercion shrinkage. See #15090. + +Note [Avoid re-simplifying coercions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In some benchmarks (with deeply nested cases) we successively push +casts onto the SimplCont. We don't want to call the coercion optimiser +on each successive composition -- that's at least quadratic. So: + +* The CastIt constructor in SimplCont has a `sc_opt :: Bool` flag to + record whether the coercion optimiser has been applied to the coercion. + +* In `simplCast`, when we see (Cast e co), we simplify `co` to get + an OutCoercion, and built a CastIt with sc_opt=True. + + Actually not quite: if we are simplifying the result of inlining an + unfolding (seInlineDepth > 0), then instead of /optimising/ it again, + just /substitute/ which is cheaper. See `simplCoercion`. + +* In `pushCast` if we combine this new coercion with an existing one, + we build a CastIt for (co1 ; co2) with sc_opt=False. + +* When unpacking a CastIt, in `rebuild`, we optimise the (presumably + composed) coercion if sc_opt=False; this is done by `optOutCoercion`. + +* When duplicating a continuation in `mkDupableContWithDmds`, before + duplicating a CastIt, optimise the coercion. Otherwise we'll end up + optimising it separately in the duplicate copies. + +* See also Note [The MOutCoercion field of ContEx] -} optOutCoercion :: SimplEnvIS -> OutCoercion -> Bool -> OutCoercion --- See Note [Avoid re-simplifying coercions] in GHC.Core.Opt.Simplify.Iteration +-- See Note [Avoid re-simplifying coercions] optOutCoercion env co already_optimised | already_optimised = co -- Ditto | otherwise = optCoercion opts empty_subst co @@ -862,7 +964,8 @@ pushCastMCo env (MCo co) cont = pushCast env co cont pushCast :: SimplEnv -> OutCoercion -> SimplCont -> SimplCont pushCast env co cont - = go co True cont + | isReflCo co = cont -- See Note [Optimising reflexivity] + | otherwise = go co True cont where -- ToDo: pushCast Refl (ApplylToVal arg1 (ApplyToVal arg2 ...)) @@ -871,7 +974,7 @@ pushCast env co cont go co1 _ (CastIt { sc_co = co2, sc_cont = cont }) -- See Note [Optimising reflexivity] in GHC.Core.Opt.Simplify.Iteration = go (mkTransCo co1 co2) False cont -- False: (mkTransCo co1 co2) is not fully optimised - -- See Note [Avoid re-simplifying coercions] in GHC.Core.Opt.Simplify.Iteration + -- See Note [Avoid re-simplifying coercions] go co co_is_opt (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = tail }) | Just (tyL, arg_ty', m_co') <- pushCoTyArg co arg_ty @@ -886,21 +989,17 @@ pushCast env co cont -- where co :: (s1->s2) ~ (t1->t2) -- co1 :: t1 ~ s1 -- co2 :: s2 ~ t2 - go co co_is_opt cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_cast = arg_mco, sc_cont = tail }) + go co co_is_opt cont@(ApplyToVal { sc_arg = arg, sc_cont = tail }) | not co_is_opt = -- pushCoValArg duplicates the coercion, so optimise first go (optOutCoercion (zapSubstEnv env) co co_is_opt) True cont | Just (tyL, m_co1, m_co2) <- pushCoValArg co = {-#SCC "addCoerce-pushCoValArg" #-} - -- Dealing with m_co1 is the entire reason for the sc_cast field - -- of ApplyToVal; see Note [The sc_cast field of ApplyToVal] - ApplyToVal { sc_arg = arg - , sc_env = arg_se - , sc_cast = arg_mco `mkTransMCo` m_co1 - , sc_cont = go_mco m_co2 True tail - , sc_hole_ty = tyL } + -- See Note [The MOutCoercion field of ContEx] + cont { sc_arg = mkCloCastMCo arg m_co1 + , sc_cont = go_mco m_co2 True tail + , sc_hole_ty = tyL } go co co_is_opt cont | isReflCo co = cont -- Having this at the end makes a huge @@ -914,6 +1013,13 @@ pushCast env co cont go_mco MRefl _ cont = cont go_mco (MCo co) opt cont = go co opt cont +mkCloCastMCo :: SimplClo -> MOutCoercion -> SimplClo +-- See Note [The MOutCoercion field of ContEx] +mkCloCastMCo clo MRefl = clo +mkCloCastMCo (DoneId v) (MCo co) = DoneEx (mkCast (Var v) co) NotJoinPoint +mkCloCastMCo (DoneEx e _) (MCo co) = DoneEx (mkCast e co) NotJoinPoint +mkCloCastMCo (ContEx se e mco) (MCo co) = ContEx se e (mco `mkTransMCo` MCo co) + {- ************************************************************************ @@ -1227,19 +1333,17 @@ Wrinkles: -} -interestingArg :: SimplEnv -> StaticEnv -> CoreExpr -> ArgSummary +interestingArg :: SimplEnv -> SimplClo -> ArgSummary -- See Note [Interesting arguments] -interestingArg env se e - = case se of - Simplified {} -> go env 0 e - UnSimplified static_env -> go (static_env `setInScopeFromE` env) 0 e +interestingArg env clo + = go_clo env 0 clo where + go_clo _ n (DoneId v) = go_var n v + go_clo env n (DoneEx e _) = go (zapSubstEnv env) n e + go_clo env n (ContEx se e _) = go (se `setInScopeFromE` env) n e + -- n is # value args to which the expression is applied - go env n (Var v) - = case substId env v of - DoneId v' -> go_var n v' - DoneEx e _ -> go (zapSubstEnv env) n e - ContEx se e _mco -> go (se `setInScopeFromE` env) n e + go env n (Var v) = go_clo env n (substId env v) go _ _ (Lit l) | isLitRubbish l = NonTrivArg -- See (IA3) in Note [Interesting arguments] @@ -1738,15 +1842,15 @@ is a term (not a coercion) so we can't necessarily inline the latter in the former. -} -preInlineUnconditionally +preInlineLetUnconditionally :: SimplEnv -> TopLevelFlag -> InId - -> StaticEnv -> CoreExpr -> MOutCoercion -- The argument + -> InExpr -> SimplEnv -- These two go together -> Maybe SimplEnv -- Returned env has extended substitution -- Precondition: rhs satisfies the let-can-float invariant -- See Note [Core let-can-float invariant] in GHC.Core -- Reason: we don't want to inline single uses, or discard dead bindings, -- for unlifted, side-effect-ful bindings -preInlineUnconditionally env top_lvl bndr rhs_se rhs rhs_mco +preInlineLetUnconditionally env top_lvl bndr rhs rhs_env | not pre_inline_unconditionally = Nothing | not active = Nothing | isTopLevel top_lvl && isDeadEndId bndr = Nothing -- Note [Top-level bottoming Ids] @@ -1758,26 +1862,15 @@ preInlineUnconditionally env top_lvl bndr rhs_se rhs rhs_mco -- See Note [Stable unfoldings and preInlineUnconditionally] | not (isInlinePragma inline_prag) - , Just inl <- maybeUnfoldingTemplate unf = assertPpr (isReflMCo rhs_mco) (ppr bndr) $ - Just $! (extend_subst_with inl) + , Just inl <- maybeUnfoldingTemplate unf = Just $! (extend_subst_with inl) | otherwise = Nothing where unf = idUnfolding bndr - -- If the rhs is /not/ already simplified, extend the envt with ContEx, which captures - -- the the lexical environment for us to restore in `simplInId`. - -- If the rhs /is/ already simplified, then extend the envt with DoneEx; - -- That makes `simplInId` call `simplOutExpr` which avoids re-simplifying - -- the RHS. - -- See Note [Avoid repeated simplification] in GHC.Core.Opt.Simplify.Iteration - extend_subst_with inl_rhs - = extendIdSubst env bndr $! - case rhs_se of - Simplified _ -> case rhs_mco of - MRefl -> DoneEx inl_rhs NotJoinPoint -- Common case - MCo co -> DoneEx (mkCast inl_rhs co) NotJoinPoint - UnSimplified rhs_env -> ContEx rhs_env inl_rhs rhs_mco + -- The rhs is not yet simplified, so extend the envt with ContEx, which + -- captures the lexical environment for us to restore in `simplInId`. + extend_subst_with inl_rhs = extendIdSubst env bndr $! ContEx rhs_env inl_rhs MRefl one_occ IAmDead = True -- Happens in ((\x.1) v) one_occ OneOcc{ occ_n_br = 1 @@ -1793,39 +1886,6 @@ preInlineUnconditionally env top_lvl bndr rhs_se rhs rhs_mco -- See Note [pre/postInlineUnconditionally in gentle mode] inline_prag = idInlinePragma bndr --- Be very careful before inlining inside a lambda, because (a) we must not --- invalidate occurrence information, and (b) we want to avoid pushing a --- single allocation (here) into multiple allocations (inside lambda). --- Inlining a *function* with a single *saturated* call would be ok, mind you. --- || (if is_cheap && not (canInlineInLam rhs) then pprTrace "preinline" (ppr bndr <+> ppr rhs) ok else ok) --- where --- is_cheap = exprIsCheap rhs --- ok = is_cheap && int_cxt - - -- int_cxt The context isn't totally boring - -- E.g. let f = \ab.BIG in \y. map f xs - -- Don't want to substitute for f, because then we allocate - -- its closure every time the \y is called - -- But: let f = \ab.BIG in \y. map (f y) xs - -- Now we do want to substitute for f, even though it's not - -- saturated, because we're going to allocate a closure for - -- (f y) every time round the loop anyhow. - - -- canInlineInLam => free vars of rhs are (Once in_lam) or Many, - -- so substituting rhs inside a lambda doesn't change the occ info. - -- Sadly, not quite the same as exprIsHNF. - canInlineInLam (Lit _) = True - canInlineInLam (Cast e _) = canInlineInLam e - canInlineInLam (Lam b e) = isRuntimeVar b || canInlineInLam e - canInlineInLam (Tick t e) = not (tickishIsCode t) && canInlineInLam e - canInlineInLam (Var v) = case idOccInfo v of - OneOcc { occ_in_lam = IsInsideLam } -> True - ManyOccs {} -> True - _ -> False - canInlineInLam _ = False - -- not ticks. Counting ticks cannot be duplicated, and non-counting - -- ticks around a Lam will disappear anyway. - early_phase = case sePhase env of SimplPhase p -> p /= FinalPhase @@ -1856,6 +1916,97 @@ preInlineUnconditionally env top_lvl bndr rhs_se rhs rhs_mco -- (Nor can we check for `exprIsExpandable rhs`, because that needs to look -- at the non-existent unfolding for the `I# 2#` which is also floated out.) +preInlineBetaUnconditionally + :: SimplEnv -> Levity -> InId + -> SimplClo -- The argument + -> Maybe SimplEnv -- Returned env has extended substitution +-- Like preInlineLetUnconditionally, but for a beta-redex (\bndr. body) arg +-- The argument may or may not be already simplified (DoneEx or ContEx) +-- +-- The binder is a lambda binder and so lacks most IdInfo; +-- see Note [Core binder IdInfo invariants] +-- +-- Compared to preInlineLetUnconditionally we omit some checks: +-- * The binder is never top-level, so no need for the +-- Note [Top-level bottoming Ids] check, nor for `early_phase` +-- * A lambda binder is never a join point, so no need for the +-- Note [Do not inline exit join points] check +-- * A lambda binder never has an inline pragma, a stable unfolding, or RULES +-- (see `lamBndrInfoOK`), so no need to check activation, nor for +-- Note [Stable unfoldings and preInlineUnconditionally] +-- +-- And we add one extra one +-- * Check the let-can-float invariant, and don't inline if not + +preInlineBetaUnconditionally env levity bndr arg + | assertPpr (lamBndrInfoOK bndr) (ppr bndr) $ + not pre_inline_unconditionally = Nothing + | isCoVar bndr = Nothing -- Note [Do not inline CoVars unconditionally] + | not (one_occ (idOccInfo bndr)) = Nothing + | needs_case_binding = Nothing -- Enforce the let-can-float invariant + | otherwise = Just $! extendIdSubst env bndr arg + -- If the arg is not yet simplified, it is a ContEx, which captures the + -- lexical environment for us to restore in `simplInId`. + -- If the arg is already simplified, then it is a DoneEx; + -- That makes `simplInId` call `simplOutExpr` which avoids re-simplifying + -- the arg. + -- See Note [Avoid repeated simplification] in GHC.Core.Opt.Simplify.Iteration + where + pre_inline_unconditionally = sePreInline env + + needs_case_binding = needsCaseBindingL levity rhs + -- Ok to test an InExpr or OutExpr in needsCaseBindingL because + -- exprOkForSpeculation is stable under simplification + + rhs :: CoreExpr -- Can be InExpr or OutExpr, but here it does not matter + rhs = case arg of + ContEx _ e _ -> e -- InExpr + DoneEx e _ -> e -- OutExpr + DoneId v -> Var v -- OutExpr + + one_occ IAmDead = True -- Happens in ((\x.1) v) + one_occ OneOcc{ occ_n_br = 1 + , occ_in_lam = NotInsideLam } = True + one_occ OneOcc{ occ_n_br = 1 + , occ_in_lam = IsInsideLam + , occ_int_cxt = IsInteresting } = canInlineInLam rhs + one_occ _ = False + + +canInlineInLam :: CoreExpr -> Bool +-- Be very careful before inlining inside a lambda, because (a) we must not +-- invalidate occurrence information, and (b) we want to avoid pushing a +-- single allocation (here) into multiple allocations (inside lambda). +-- Inlining a *function* with a single *saturated* call would be ok, mind you. +-- || (if is_cheap && not (canInlineInLam rhs) then pprTrace "preinline" (ppr bndr <+> ppr rhs) ok else ok) +-- where +-- is_cheap = exprIsCheap rhs +-- ok = is_cheap && int_cxt + + -- int_cxt The context isn't totally boring + -- E.g. let f = \ab.BIG in \y. map f xs + -- Don't want to substitute for f, because then we allocate + -- its closure every time the \y is called + -- But: let f = \ab.BIG in \y. map (f y) xs + -- Now we do want to substitute for f, even though it's not + -- saturated, because we're going to allocate a closure for + -- (f y) every time round the loop anyhow. + + -- canInlineInLam => free vars of rhs are (Once in_lam) or Many, + -- so substituting rhs inside a lambda doesn't change the occ info. + -- Sadly, not quite the same as exprIsHNF. +canInlineInLam (Lit _) = True +canInlineInLam (Cast e _) = canInlineInLam e +canInlineInLam (Lam b e) = isRuntimeVar b || canInlineInLam e +canInlineInLam (Tick t e) = not (tickishIsCode t) && canInlineInLam e +canInlineInLam (Var v) = case idOccInfo v of + OneOcc { occ_in_lam = IsInsideLam } -> True + ManyOccs {} -> True + _ -> False +canInlineInLam _ = False + -- not ticks. Counting ticks cannot be duplicated, and non-counting + -- ticks around a Lam will disappear anyway. + {- ************************************************************************ * * ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -2068,7 +2068,11 @@ mkSeqs seqees res_ty rhs = -- Argument representing strict field and it's worth passing via cbv | wantCbvForId arg_id = Case (Var arg_id) - (localiseId arg_id) -- See (SCF1) in Note [SpecConstr and strict fields] + (mkCaseBndrFromLetBndr (localiseId arg_id)) + -- localiseId: see (SCF1) in Note [SpecConstr and strict fields] + -- mkCaseBndrFromLetBndr: arg_id may have IdInfo (e.g. an unfolding, + -- if it is a global) that a case binder must not have; see + -- Note [Core binder IdInfo invariants] in GHC.Core res_ty ([Alt DEFAULT [] rhs]) ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1041,7 +1041,7 @@ unbox_one_arg opts arg_var -- Apply str info to new args. Also remove OtherCon unfoldings so they -- don't end up in lambda binders of the worker. - -- See Note [Never put `OtherCon` unfoldings on lambda binders] + -- See (CBI1) in Note [Core binder IdInfo invariants] arg_ids' = map zapIdUnfolding $ zipWithEqual setIdDemandInfo arg_ids ds @@ -1711,8 +1711,7 @@ unbox_one_result opts res_bndr move_transit_vars :: [Id] -> (CoreExpr -> CoreExpr -> CoreExpr, CoreExpr) move_transit_vars vars | [var] <- vars - , let var_ty = idType var - , isUnliftedType var_ty || exprIsHNF (Var var) + , varIsHNF var -- NB: True of variables of unlifted type -- See Note [No unboxed tuple for single, unlifted transit var] -- * Wrapper: `unbox scrut alt = (case <scrut> of a -> <alt>)` -- * Worker: `tup = a` @@ -1816,7 +1815,7 @@ return unboxed instead of in an unboxed singleton tuple: We want `$wh :: Int# -> [Int]`. We'd get `$wh :: Int# -> (# [Int] #)`. -By considering vars as unlifted that satisfy 'exprIsHNF', we catch (3). +By considering vars as unlifted that satisfy 'varIsHNF', we catch (3). Why not check for 'exprOkForSpeculation'? Quite perplexingly, evaluated vars are not ok-for-spec, see Note [exprOkForSpeculation and evaluated variables]. For (1) and (2) we would have to look at the term. WW only looks at the ===================================== compiler/GHC/Core/Ppr.hs ===================================== @@ -637,6 +637,7 @@ instance Outputable IdInfo where [ (has_prag, text "InlPrag=" <> pprInlineDebug prag_info) , (has_occ, text "Occ=" <> ppr occ_info) , (has_dmd, text "Dmd=" <> ppr dmd_info) + , (has_cpr, text "Cpr=" <> ppr dmd_info) , (has_lbv , text "OS=" <> ppr lbv_info) , (has_arity, text "Arity=" <> int arity) , (has_called_arity, text "CallArity=" <> int called_arity) @@ -658,6 +659,9 @@ instance Outputable IdInfo where lbv_info = oneShotInfo info has_lbv = not (hasNoOneShotInfo lbv_info) + cpr = cprSigInfo info + has_cpr = not $ isTopCprSig cpr + arity = arityInfo info has_arity = arity /= 0 ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -29,7 +29,7 @@ module GHC.Core.Utils ( exprIsTrivial, getIdFromTrivialExpr, getIdFromTrivialExpr_maybe, trivial_expr_fold, exprIsDupable, exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun, - exprIsHNF, exprOkForSpeculation, exprOkToDiscard, exprOkForSpecEval, + exprIsHNF, varIsHNF, exprOkForSpeculation, exprOkToDiscard, exprOkForSpecEval, exprIsWorkFree, exprIsConLike, isCheapApp, isExpandableApp, isSaturatedConApp, exprIsTickedString, exprIsTickedString_maybe, @@ -756,7 +756,10 @@ bindNonRec bndr rhs body | needsCaseBinding (idType bndr) rhs = case_bind | otherwise = let_bind where - case_bind = mkDefaultCase rhs bndr body + case_bind = mkDefaultCase rhs (mkCaseBndrFromLetBndr bndr) body + -- mkCaseBndrFromLetBndr: bndr may have IdInfo suitable for a + -- let-binder; see Note [Core binder IdInfo invariants] + -- in GHC.Core let_bind = Let (NonRec bndr rhs) body -- | `needsCaseBinding` tests whether we have to use a @case@ rather than @let@ @@ -2630,12 +2633,37 @@ it doesn't have the trickiness of the let-can-float invariant to worry about. exprIsHNF :: CoreExpr -> Bool -- True => Value-lambda, constructor, PAP exprIsHNF = exprIsHNFlike isDataConWorkId isEvaldUnfolding True +-- | @varIsHNF v@ is the same as @exprIsHNF (Var v)@, but avoids building +-- the @Var@ only to take it apart again +varIsHNF :: Var -> Bool +varIsHNF = varIsHNFlike isDataConWorkId isEvaldUnfolding + -- | Similar to 'exprIsHNF' but includes CONLIKE functions as well as -- data constructors. Conlike arguments are considered interesting by the -- inliner. exprIsConLike :: CoreExpr -> Bool -- True => lambda, conlike, PAP exprIsConLike = exprIsHNFlike isConLikeId isConLikeUnfolding False +varIsHNFlike :: (Var -> Bool) -> (Unfolding -> Bool) -> Var -> Bool +-- The (Var v) case of exprIsHNFlike +{-# INLINE varIsHNFlike #-} +varIsHNFlike is_con is_con_unf v + = idArity v > 0 || is_con v + -- A PAP is a value, as is a nullary constructor, so that [] and () + -- are values, for example; and (e.g.) primops that don't have unfoldings. + -- This is (id_app_is_value v []) in exprIsHNFlike + + || is_con_unf (idUnfolding v) + -- Check the thing's unfolding; it might be bound to a value + -- or to a guaranteed-evaluated variable (isEvaldUnfolding) + -- Contrast with Note [exprOkForSpeculation and evaluated variables] + -- We don't look through loop breakers here, which is a bit conservative + -- but otherwise I worry that if an Id's unfolding is just itself, + -- we could get an infinite loop + + || definitelyUnliftedType (idType v) + -- Unlifted binders are always evaluated (#20140) + -- | Returns true for values or value-like expressions. These are lambdas, -- constructors / CONLIKE functions (as determined by the function argument) -- or PAPs. @@ -2649,20 +2677,8 @@ exprIsHNFlike is_con is_con_unf rubbish_lit_result e = -- pprTraceWith "hnf" (\r -> ppr r <+> ppr e) $ is_hnf_like e where - is_hnf_like (Var v) -- NB: There are no value args at this point - = id_app_is_value v [] -- Catches nullary constructors, - -- so that [] and () are values, for example - -- and (e.g.) primops that don't have unfoldings - || is_con_unf (idUnfolding v) - -- Check the thing's unfolding; it might be bound to a value - -- or to a guaranteed-evaluated variable (isEvaldUnfolding) - -- Contrast with Note [exprOkForSpeculation and evaluated variables] - -- We don't look through loop breakers here, which is a bit conservative - -- but otherwise I worry that if an Id's unfolding is just itself, - -- we could get an infinite loop - - || definitelyUnliftedType (idType v) - -- Unlifted binders are always evaluated (#20140) + is_hnf_like (Var v) = varIsHNFlike is_con is_con_unf v + -- NB: There are no value args at this point is_hnf_like (Lit lit) | isLitRubbish lit = rubbish_lit_result ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -264,8 +264,14 @@ bindMatchId new mid body -- Used to force variables when desugaring strict binders. It's crucial that the -- variable is shadowed by the case binder. See Wrinkle 1 in -- Note [Desugar Strict binds] in GHC.HsToCore.Binds. +-- +-- The case binder has the same Name (and hence Unique), type and multiplicity +-- as `var`, but not its IdInfo: `var` may have, say, a NOINLINE pragma, but a +-- case binder must not; see Note [Core binder IdInfo invariants] +-- in GHC.Core, and #27965. E.g. `res1` in GHC.Internal.Control.Monad.ST.Lazy.Imp +-- has a NOINLINE pragma. seqVar :: Var -> CoreExpr -> CoreExpr -seqVar var body = mkDefaultCase (Var var) var body +seqVar var body = mkDefaultCase (Var var) (mkCaseBndrFromLetBndr var) body mkCoLetMatchResult :: HasDebugCallStack => CoreBind -> MatchResult CoreExpr -> MatchResult CoreExpr mkCoLetMatchResult bind = fmap (mkCoreLet bind) ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -94,6 +94,7 @@ module GHC.Types.Id ( idArity, idCallArity, idFunRepArity, idSpecialisation, idCoreRules, idHasRules, + lamBndrInfoOK, idCafInfo, idLFInfo_maybe, idOneShotInfo, idOccInfo, @@ -102,7 +103,7 @@ module GHC.Types.Id ( alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun, -- ** Writing 'IdInfo' fields - setIdUnfolding, zapIdUnfolding, setCaseBndrEvald, + setIdUnfolding, zapIdUnfolding, setCaseBndrEvald, mkCaseBndrFromLetBndr, setIdArity, setIdCallArity, @@ -881,10 +882,21 @@ setCaseBndrEvald :: StrictnessMark -> Id -> Id -- itself, and any pattern-bound variables that are argument of a -- strict constructor. It just marks the variable as already-evaluated, -- so that (for example) a subsequent 'seq' can be dropped +-- See Note [Evaluated-ness on case binders] in GHC.Core setCaseBndrEvald str id | isMarkedStrict str = id `setIdUnfolding` evaldUnfolding | otherwise = id +-- | Make a case binder from a binder that might have been let-bound, e.g. +-- let x = rhs in body ==> case rhs of x { DEFAULT -> body } +-- The let-binder may have IdInfo (an unfolding, an inline pragma, RULES) +-- that a case binder must not have, so we keep its Name, type, multiplicity +-- and IdDetails, but reset its IdInfo, except that we record that it is +-- evaluated. +-- See Note [Core binder IdInfo invariants] in GHC.Core +mkCaseBndrFromLetBndr :: Id -> Id +mkCaseBndrFromLetBndr id = id `setIdInfo` (vanillaIdInfo `setUnfoldingInfo` evaldUnfolding) + -- | Similar to trimUnfolding, but also removes evaldness info. zapIdUnfolding :: Id -> Id zapIdUnfolding v @@ -905,6 +917,32 @@ idCoreRules id = ruleInfoRules (idSpecialisation id) idHasRules :: Id -> Bool idHasRules id = not (isEmptyRuleInfo (idSpecialisation id)) +-- | True <=> the Id has only the IdInfo permitted on a lambda, case, or +-- case-alternative binder. See the table in Note [Core binder IdInfo invariants] +-- in GHC.Core; Core Lint checks this invariant. +-- +-- We allow occurrence info, demand info, and one-shot info (which the table +-- permits only on lambda binders, but a case binder may be about to become one). +-- We also allow an `OtherCon []` unfolding; lambda binders must have no unfolding +-- at all, but Lint checks that separately. +lamBndrInfoOK :: Id -> Bool +lamBndrInfoOK id + = isDefaultInlinePragma (inlinePragInfo info) + && isNopSig (dmdSigInfo info) + && isTopCprSig (cprSigInfo info) + && mayHaveCafRefs (cafInfo info) + && arityInfo info == unknownArity + && callArityInfo info == unknownArity + && isEmptyRuleInfo (ruleInfo info) + && unf_ok (realUnfoldingInfo info) + where + info = idInfo id + + -- See Note [Evaluated-ness on case binders] in GHC.Core + unf_ok NoUnfolding = True + unf_ok (OtherCon []) = True + unf_ok _ = False + setIdSpecialisation :: Id -> RuleInfo -> Id setIdSpecialisation id spec_info = modifyIdInfo (`setRuleInfo` spec_info) id ===================================== testsuite/tests/simplCore/should_compile/T27962.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE MagicHash #-} + +module T27962 where + +import GHC.Exts + +newtype N = MkN Int + +-- After inlining myRun, we get (runRW# @LiftedRep @Int |> co) (\_ -> ...) +-- and the simplifier pushes co into the argument of runRW#. +-- #27962: the simplifier dropped that cast, yielding ill-typed Core +myRun :: (State# RealWorld -> N) -> N +myRun = coerce (runRW# :: (State# RealWorld -> Int) -> Int) +{-# INLINE myRun #-} + +foo x = myRun (\_ -> MkN (x+1)) ===================================== testsuite/tests/simplCore/should_compile/T27963.hs ===================================== @@ -0,0 +1,23 @@ +{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-} + +module T27963 where + +-- This test is pretty delicate because it relies on a function +-- that has BOTH a rule AND an INLINE pragma +-- +-- See #27963 for some discussion +-- +-- Still, it should (just) work + +import GHC.Exts + +newtype N = MkN Int + +f x = x +{-# INLINE f #-} +{-# RULES "f/42" forall x. f x = 42::Int #-} + +-- The rule "f/42" should fire in both h1 and h2 +h1,h2 :: N -> Int +h1 n = f (coerce n) + 0 +h2 n = (coerce f) n + 0 -- #27963: the rule did not fire here ===================================== testsuite/tests/simplCore/should_compile/T27963.stderr ===================================== @@ -0,0 +1,2 @@ +Rule fired: f/42 (T27963) +Rule fired: f/42 (T27963) ===================================== testsuite/tests/simplCore/should_compile/T27965.hs ===================================== @@ -0,0 +1,9 @@ +-- Lint checks that we don't produce a lambda-binder +-- with a NOINLINE pragma on it (#27965) + +module T27965 where + +h fm s = let {-# NOINLINE res1 #-} + !res1 = fm s + !(f, s') = res1 + in (f+1::Int, s') ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -629,3 +629,7 @@ test('T27749', test('T27629', only_ways(['optasm']), makefile_test, ['T27629']) test('T27936', normal, compile, ['']) test('T27910', grep_errmsg(r'KnownBranch'), compile, ['-O -dno-typeable-binds -ddump-simpl-stats -dsuppress-uniques']) +test('T27962', normal, compile, ['']) +test('T27962a', [extra_files(['T27962.hs'])], multimod_compile, ['T27962', '-v0 -O']) +test('T27963', [grep_errmsg(r'f/42')], compile, ['-O -ddump-rule-firings']) +test('T27965', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db813b76bf7695014dfb1263d9ba4bf... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db813b76bf7695014dfb1263d9ba4bf... 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