Simon Peyton Jones pushed to branch wip/T20264 at Glasgow Haskell Compiler / GHC Commits: 9be7029d by Simon Peyton Jones at 2026-01-30T13:03:27+00:00 Expand tyvars in Specialise Pretty important! - - - - - 1347e1f2 by Simon Peyton Jones at 2026-01-30T13:04:00+00:00 Comments only - - - - - 3 changed files: - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -823,8 +823,8 @@ andFF FltOkSpec _ = FltOkSpec andFF FltLifted flt = flt -doFloatFromRhs :: SimplEnv -> TopLevelFlag -> RecFlag -> Bool - -> [OutTyVar] -> SimplFloats -> OutExpr -> Bool +doFloatFromRhs :: SimplEnv -> TopLevelFlag -> RecFlag -> Bool -> [OutTyVar] + -> SimplFloats -> OutExpr -> Bool -- If you change this function look also at FloatIn.noFloatIntoRhs doFloatFromRhs env lvl rec strict_bind tvs (SimplFloats { sfLetFloats = LetFloats fs ff }) rhs = not (isNilOL fs) ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -2626,17 +2626,23 @@ specHeader subst (bndr:bndrs) (SpecType ty : args) -- See (MP2) in Note [Specialising polymorphic dictionaries] let in_scope = Core.substInScopeSet subst not_in_scope tv = not (tv `elemInScopeSet` in_scope) + + expanded_ty = expandSomeTyVarUnfoldings not_in_scope ty + -- expanded_ty: consider f @(Maybe (a{=Int}) + -- We don't want to abstract over `a`! So, expand + -- unfoldings of any not-in-scope tyavars + free_tvs = scopedSort $ fvVarList $ filterFV not_in_scope $ - tyCoFVsOfType ty + tyCoFVsOfType expanded_ty subst1 = subst `Core.extendSubstInScopeList` free_tvs - ; let subst2 = Core.extendTvSubst subst1 bndr ty + ; let subst2 = Core.extendTvSubst subst1 bndr expanded_ty ; (useful, subst3, rule_bs, rule_args, spec_bs, dx, spec_args) <- specHeader subst2 bndrs args ; pure ( useful, subst3 - , free_tvs ++ rule_bs, Type ty : rule_args - , free_tvs ++ spec_bs, dx, Type ty : spec_args ) } + , free_tvs ++ rule_bs, Type expanded_ty : rule_args + , free_tvs ++ spec_bs, dx, Type expanded_ty : spec_args ) } -- Next we have a type that we don't want to specialise. We need to perform -- a substitution on it (in case the type refers to 'a'). Additionally, we need ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -1618,6 +1618,101 @@ in this (which it previously was): in g False -> \x. x in \w. v True + +Note [isCheapApp: bottoming functions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +I'm not sure why we have a special case for bottoming +functions in isCheapApp. Maybe we don't need it. + +Note [exprIsExpandable] +~~~~~~~~~~~~~~~~~~~~~~~ +An expression is "expandable" if we are willing to duplicate it, if doing +so might make a RULE or case-of-constructor fire. Consider + let x = (a,b) + y = build g + in ....(case x of (p,q) -> rhs)....(foldr k z y).... + +We don't inline 'x' or 'y' (see Note [Lone variables] in GHC.Core.Unfold), +but we do want + + * the case-expression to simplify + (via exprIsConApp_maybe, exprIsLiteral_maybe) + + * the foldr/build RULE to fire + (by expanding the unfolding during rule matching) + +So we classify the unfolding of a let-binding as "expandable" (via the +uf_expandable field) if we want to do this kind of on-the-fly +expansion. Specifically: + +* True of constructor applications (K a b) + +* True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in GHC.Types.Basic. + (NB: exprIsCheap might not be true of this) + +* False of case-expressions. If we have + let x = case ... in ...(case x of ...)... + we won't simplify. We have to inline x. See #14688. + +* False of let-expressions (same reason); and in any case we + float lets out of an RHS if doing so will reveal an expandable + application (see SimplEnv.doFloatFromRhs). + +* Take care: exprIsExpandable should /not/ be true of primops. I + found this in test T5623a: + let q = /\a. Ptr a (a +# b) + in case q @ Float of Ptr v -> ...q... + + q's inlining should not be expandable, else exprIsConApp_maybe will + say that (q @ Float) expands to (Ptr a (a +# b)), and that will + duplicate the (a +# b) primop, which we should not do lightly. + (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.) + +NB: exprIsWorkFree implies exprIsExpandable. + +Note [isExpandableApp: bottoming functions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It's important that isExpandableApp does not respond True to bottoming +functions. Recall undefined :: HasCallStack => a +Suppose isExpandableApp responded True to (undefined d), and we had: + + x = undefined <dict-expr> + +Then Simplify.prepareRhs would ANF the RHS: + + d = <dict-expr> + x = undefined d + +This is already bad: we gain nothing from having x bound to (undefined +var), unlike the case for data constructors. Worse, we get the +simplifier loop described in OccurAnal Note [Cascading inlines]. +Suppose x occurs just once; OccurAnal.occAnalNonRecRhs decides x will +certainly_inline; so we end up inlining d right back into x; but in +the end x doesn't inline because it is bottom (preInlineUnconditionally); +so the process repeats.. We could elaborate the certainly_inline logic +some more, but it's better just to treat bottoming bindings as +non-expandable, because ANFing them is a bad idea in the first place. + +Note [Record selection] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +I'm experimenting with making record selection +look cheap, so we will substitute it inside a +lambda. Particularly for dictionary field selection. + +BUT: Take care with (sel d x)! The (sel d) might be cheap, but +there's no guarantee that (sel d x) will be too. Hence (n_val_args == 1) + +Note [Expandable overloadings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose the user wrote this + {-# RULE forall x. foo (negate x) = h x #-} + f x = ....(foo (negate x)).... +They'd expect the rule to fire. But since negate is overloaded, we might +get this: + f = \d -> let n = negate d in \x -> ...foo (n x)... +So we treat the application of a function (negate in this case) to a +*dictionary* as expandable. In effect, every function is CONLIKE when +it's applied only to dictionaries. -} ------------------------------------- @@ -1690,6 +1785,10 @@ isWorkFreeApp fn n_val_args _ -> False isCheapApp :: CheapAppFun +-- Like isWorkFreeApp, but add: +-- - bottoming applications +-- - cheap (rather than just work-free) primops +-- - record selectors applied to just the record isCheapApp fn n_val_args | isWorkFreeApp fn n_val_args = True | isDeadEndId fn = True -- See Note [isCheapApp: bottoming functions] @@ -1706,6 +1805,10 @@ isCheapApp fn n_val_args -- to bother to check the number of args isExpandableApp :: CheapAppFun +-- Like isWorkFreeApp, but add: +-- - record selectors applied to just the record +-- - ConLike Ids (if not bottoming) +-- - a function applied to dictionaries isExpandableApp fn n_val_args | isWorkFreeApp fn n_val_args = True | otherwise @@ -1737,101 +1840,6 @@ isExpandableApp fn n_val_args | otherwise = False -{- Note [isCheapApp: bottoming functions] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -I'm not sure why we have a special case for bottoming -functions in isCheapApp. Maybe we don't need it. - -Note [exprIsExpandable] -~~~~~~~~~~~~~~~~~~~~~~~ -An expression is "expandable" if we are willing to duplicate it, if doing -so might make a RULE or case-of-constructor fire. Consider - let x = (a,b) - y = build g - in ....(case x of (p,q) -> rhs)....(foldr k z y).... - -We don't inline 'x' or 'y' (see Note [Lone variables] in GHC.Core.Unfold), -but we do want - - * the case-expression to simplify - (via exprIsConApp_maybe, exprIsLiteral_maybe) - - * the foldr/build RULE to fire - (by expanding the unfolding during rule matching) - -So we classify the unfolding of a let-binding as "expandable" (via the -uf_expandable field) if we want to do this kind of on-the-fly -expansion. Specifically: - -* True of constructor applications (K a b) - -* True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in GHC.Types.Basic. - (NB: exprIsCheap might not be true of this) - -* False of case-expressions. If we have - let x = case ... in ...(case x of ...)... - we won't simplify. We have to inline x. See #14688. - -* False of let-expressions (same reason); and in any case we - float lets out of an RHS if doing so will reveal an expandable - application (see SimplEnv.doFloatFromRhs). - -* Take care: exprIsExpandable should /not/ be true of primops. I - found this in test T5623a: - let q = /\a. Ptr a (a +# b) - in case q @ Float of Ptr v -> ...q... - - q's inlining should not be expandable, else exprIsConApp_maybe will - say that (q @ Float) expands to (Ptr a (a +# b)), and that will - duplicate the (a +# b) primop, which we should not do lightly. - (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.) - -NB: exprIsWorkFree implies exprIsExpandable. - -Note [isExpandableApp: bottoming functions] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It's important that isExpandableApp does not respond True to bottoming -functions. Recall undefined :: HasCallStack => a -Suppose isExpandableApp responded True to (undefined d), and we had: - - x = undefined <dict-expr> - -Then Simplify.prepareRhs would ANF the RHS: - - d = <dict-expr> - x = undefined d - -This is already bad: we gain nothing from having x bound to (undefined -var), unlike the case for data constructors. Worse, we get the -simplifier loop described in OccurAnal Note [Cascading inlines]. -Suppose x occurs just once; OccurAnal.occAnalNonRecRhs decides x will -certainly_inline; so we end up inlining d right back into x; but in -the end x doesn't inline because it is bottom (preInlineUnconditionally); -so the process repeats.. We could elaborate the certainly_inline logic -some more, but it's better just to treat bottoming bindings as -non-expandable, because ANFing them is a bad idea in the first place. - -Note [Record selection] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -I'm experimenting with making record selection -look cheap, so we will substitute it inside a -lambda. Particularly for dictionary field selection. - -BUT: Take care with (sel d x)! The (sel d) might be cheap, but -there's no guarantee that (sel d x) will be too. Hence (n_val_args == 1) - -Note [Expandable overloadings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose the user wrote this - {-# RULE forall x. foo (negate x) = h x #-} - f x = ....(foo (negate x)).... -They'd expect the rule to fire. But since negate is overloaded, we might -get this: - f = \d -> let n = negate d in \x -> ...foo (n x)... -So we treat the application of a function (negate in this case) to a -*dictionary* as expandable. In effect, every function is CONLIKE when -it's applied only to dictionaries. --} isUnaryClassId :: Id -> Bool -- True of (a) the method selector (classop) @@ -3265,8 +3273,8 @@ So: * When we make an AbsVars list, we close over the free vars of the unfoldings of any tyvars in it. So if `b{=Maybe a}` is in the list then so is `a` -* `mkCoreAbsLams` (more generally `mkPolyAbsLams`) forms a lambda abstraction pushing - the tyvar bindings into the body: +* `mkCoreAbsLams` (more generally `mkPolyAbsLams`) forms a lambda abstraction + pushing the tyvar bindings into the body: mkCoreAbsLams [a, b=[a], x:b] body = \a. \(x:[a]). let @b = [a] in let x:b = x in -- See (AFV1) @@ -3301,8 +3309,10 @@ type TaggedAbsVars t = [TaggedBndr t] mkPolyAbsLams :: forall b. (b -> AbsVar, Var -> b -> b) -> [b] -> Expr b -> Expr b --- `mkPolyAbsLams` is polymorphic in (get,set) so that we can --- use it for both CoreExpr and LevelledExpr +-- `mkPolyAbsLams` is polymorphic in (get,set) so that we +-- can use it for both CoreExpr and LevelledExpr. See +-- - mkCoreAbsLams +-- - mkTaggedAbsLams {-# INLINE mkPolyAbsLams #-} mkPolyAbsLams (getter,setter) bndrs body = go emptyVarSet [] bndrs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdc5c34c4d36b1a0c7f4f3066b2bb76... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdc5c34c4d36b1a0c7f4f3066b2bb76... You're receiving this email because of your account on gitlab.haskell.org.