diff options
Diffstat (limited to 'compiler/GHC')
-rw-r--r-- | compiler/GHC/Core.hs | 20 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/Simplify.hs | 243 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/WorkWrap.hs | 44 | ||||
-rw-r--r-- | compiler/GHC/Core/Unfold.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Core/Unfold/Make.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Types/Id.hs | 11 |
6 files changed, 220 insertions, 104 deletions
diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs index 05df4a7a7d..a17604300f 100644 --- a/compiler/GHC/Core.hs +++ b/compiler/GHC/Core.hs @@ -64,8 +64,8 @@ module GHC.Core ( maybeUnfoldingTemplate, otherCons, isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding, - isStableUnfolding, hasCoreUnfolding, hasSomeUnfolding, - isBootUnfolding, + isStableUnfolding, isInlineUnfolding, isBootUnfolding, + hasCoreUnfolding, hasSomeUnfolding, canUnfold, neverUnfoldGuidance, isStableSource, -- * Annotated expression data types @@ -1462,6 +1462,22 @@ isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src isStableUnfolding (DFunUnfolding {}) = True isStableUnfolding _ = False +isInlineUnfolding :: Unfolding -> Bool +-- ^ True of a /stable/ unfolding that is +-- (a) always inlined; that is, with an `UnfWhen` guidance, or +-- (b) a DFunUnfolding which never needs to be inlined +isInlineUnfolding (CoreUnfolding { uf_src = src, uf_guidance = guidance }) + | isStableSource src + , UnfWhen {} <- guidance + = True + +isInlineUnfolding (DFunUnfolding {}) + = True + +-- Default case +isInlineUnfolding _ = False + + -- | Only returns False if there is no unfolding information available at all hasSomeUnfolding :: Unfolding -> Bool hasSomeUnfolding NoUnfolding = False diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs index be8b72ace4..caa18050e2 100644 --- a/compiler/GHC/Core/Opt/Simplify.hs +++ b/compiler/GHC/Core/Opt/Simplify.hs @@ -359,8 +359,8 @@ simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se -- ANF-ise a constructor or PAP rhs -- We get at most one float per argument here - ; (let_floats, bndr2, body2) <- {-#SCC "prepareBinding" #-} - prepareBinding env top_lvl bndr bndr1 body1 + ; (let_floats, body2) <- {-#SCC "prepareBinding" #-} + prepareBinding env top_lvl bndr1 body1 ; let body_floats2 = body_floats1 `addLetFloats` let_floats ; (rhs_floats, rhs') @@ -385,7 +385,7 @@ simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se ; return (floats, rhs') } ; (bind_float, env2) <- completeBind (env `setInScopeFromF` rhs_floats) - top_lvl Nothing bndr bndr2 rhs' + top_lvl Nothing bndr bndr1 rhs' ; return (rhs_floats `addFloats` bind_float, env2) } -------------------------- @@ -442,8 +442,7 @@ completeNonRecX :: TopLevelFlag -> SimplEnv completeNonRecX top_lvl env is_strict old_bndr new_bndr new_rhs = assertPpr (not (isJoinId new_bndr)) (ppr new_bndr) $ - do { (prepd_floats, new_bndr, new_rhs) - <- prepareBinding env top_lvl old_bndr new_bndr new_rhs + do { (prepd_floats, new_rhs) <- prepareBinding env top_lvl new_bndr new_rhs ; let floats = emptyFloats env `addLetFloats` prepd_floats ; (rhs_floats, rhs2) <- if doFloatFromRhs NotTopLevel NonRecursive is_strict floats new_rhs @@ -461,22 +460,24 @@ completeNonRecX top_lvl env is_strict old_bndr new_bndr new_rhs {- ********************************************************************* * * - prepareBinding, prepareRhs, makeTrivial + Cast worker/wrapper * * ************************************************************************ -Note [Cast worker/wrappers] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Cast worker/wrapper] +~~~~~~~~~~~~~~~~~~~~~~~~~~ When we have a binding x = e |> co we want to do something very similar to worker/wrapper: $wx = e x = $wx |> co -So now x can be inlined freely. There's a chance that e will be a -constructor application or function, or something like that, so moving -the coercion to the usage site may well cancel the coercions and lead -to further optimisation. Example: +We call this making a cast worker/wrapper in tryCastWorkerWrapper. + +The main motivaiton is that x can be inlined freely. There's a chance +that e will be a constructor application or function, or something +like that, so moving the coercion to the usage site may well cancel +the coercions and lead to further optimisation. Example: data family T a :: * data instance T Int = T Int @@ -489,39 +490,71 @@ to further optimisation. Example: go n = case t of { T m -> go (n-m) } -- This case should optimise -We call this making a cast worker/wrapper, and it's done by prepareBinding. - -We need to be careful with inline/noinline pragmas: - rec { {-# NOINLINE f #-} - f = (...g...) |> co - ; g = ...f... } -This is legitimate -- it tells GHC to use f as the loop breaker -rather than g. Now we do the cast thing, to get something like - rec { $wf = ...g... - ; f = $wf |> co - ; g = ...f... } -Where should the NOINLINE pragma go? If we leave it on f we'll get - rec { $wf = ...g... - ; {-# NOINLINE f #-} - f = $wf |> co - ; g = ...f... } -and that is bad: the whole point is that we want to inline that -cast! We want to transfer the pagma to $wf: - rec { {-# NOINLINE $wf #-} - $wf = ...g... - ; f = $wf |> co - ; g = ...f... } -It's exactly like worker/wrapper for strictness analysis: +A second reason for doing cast worker/wrapper is that the worker/wrapper +pass after strictness analysis can't deal with RHSs like + f = (\ a b c. blah) |> co +Instead, it relies on cast worker/wrapper to get rid of the cast, +leaving a simpler job for demand-analysis worker/wrapper. See #19874. + +Wrinkles + +1. We must /not/ do cast w/w on + f = g |> co + otherwise it'll just keep repeating forever! You might think this + is avoided because the call to tryCastWorkerWrapper is guarded by + preInlineUnconditinally, but I'm worried that a loop-breaker or an + exported Id might say False to preInlineUnonditionally. + +2. We need to be careful with inline/noinline pragmas: + rec { {-# NOINLINE f #-} + f = (...g...) |> co + ; g = ...f... } + This is legitimate -- it tells GHC to use f as the loop breaker + rather than g. Now we do the cast thing, to get something like + rec { $wf = ...g... + ; f = $wf |> co + ; g = ...f... } + Where should the NOINLINE pragma go? If we leave it on f we'll get + rec { $wf = ...g... + ; {-# NOINLINE f #-} + f = $wf |> co + ; g = ...f... } + and that is bad: the whole point is that we want to inline that + cast! We want to transfer the pagma to $wf: + rec { {-# NOINLINE $wf #-} + $wf = ...g... + ; f = $wf |> co + ; g = ...f... } + c.f. Note [Worker/wrapper for NOINLINE functions] in GHC.Core.Opt.WorkWrap. + +3. We should still do cast w/w even if `f` is INLINEABLE. E.g. + {- f: Stable unfolding = <stable-big> -} + f = (\xy. <big-body>) |> co + Then we want to w/w to + {- $wf: Stable unfolding = <stable-big> |> sym co -} + $wf = \xy. <big-body> + f = $wf |> co + Notice that the stable unfolding moves to the worker! Now demand analysis + will work fine on $wf, whereas it has trouble with the original f. + c.f. Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap. + +4. We should /not/ do cast w/w for INLINE functions (hence isInlineUnfolding in + tryCastWorkerWrapper) becuase they'll be inlined, cast and all anyway. And + if we do cast w/w for an INLINE function with arity zero, we get something + really silly: we inline that "worker" right back into the wrapper! Worse than + a no-op, because we haev then lost the stable unfolding. + +Both these wrinkles are exactly like worker/wrapper for strictness analysis: f is the wrapper and must inline like crazy $wf is the worker and must carry f's original pragma -See Note [Worker/wrapper for NOINLINE functions] in -GHC.Core.Opt.WorkWrap. +See Note [Worker/wrapper for INLINABLE functions] +and Note [Worker/wrapper for NOINLINE functions] in GHC.Core.Opt.WorkWrap. -See #17673, #18093, #18078. +See #17673, #18093, #18078, #19890. Note [Preserve strictness in cast w/w] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the Note [Cast worker/wrappers] transformation, keep the strictness info. +In the Note [Cast worker/wrapper] transformation, keep the strictness info. Eg f = e `cast` co -- f has strictness SSL When we transform to @@ -551,41 +584,79 @@ instead, we use (case erorr ... of {}). So I'm not sure this Note makes much sense any more. -} -prepareBinding :: SimplEnv -> TopLevelFlag - -> InId -> OutId -> OutExpr - -> SimplM (LetFloats, OutId, OutExpr) - -prepareBinding env top_lvl old_bndr bndr rhs - | Cast rhs1 co <- rhs - -- Try for cast worker/wrapper - -- See Note [Cast worker/wrappers] - , not (isStableUnfolding (realIdUnfolding old_bndr)) - -- Don't make a cast w/w if the thing is going to be inlined anyway - , not (exprIsTrivial rhs1) - -- Nor if the RHS is trivial; then again it'll be inlined - , let ty1 = coercionLKind co - , not (isUnliftedType ty1) - -- Not if rhs has an unlifted type; see Note [Cast w/w: unlifted] - = do { (floats, new_id) <- makeTrivialBinding (getMode env) top_lvl - (getOccFS bndr) worker_info rhs1 ty1 - ; let bndr' = bndr `setInlinePragma` mkCastWrapperInlinePrag (idInlinePragma bndr) - ; return (floats, bndr', Cast (Var new_id) co) } - - | otherwise - = do { (floats, rhs') <- prepareRhs (getMode env) top_lvl (getOccFS bndr) rhs - ; return (floats, bndr, rhs') } - where - info = idInfo bndr - worker_info = vanillaIdInfo `setDmdSigInfo` dmdSigInfo info - `setCprSigInfo` cprSigInfo info - `setDemandInfo` demandInfo info - `setInlinePragInfo` inlinePragInfo info - `setArityInfo` arityInfo info - -- We do /not/ want to transfer OccInfo, Rules, Unfolding - -- Note [Preserve strictness in cast w/w] +tryCastWorkerWrapper :: SimplEnv -> TopLevelFlag + -> InId -> OccInfo + -> OutId -> OutExpr + -> SimplM (SimplFloats, SimplEnv) +-- See Note [Cast worker/wrapper] +tryCastWorkerWrapper env top_lvl old_bndr occ_info bndr (Cast rhs co) + | not (isJoinId bndr) -- Not for join points + , not (isDFunId bndr) -- nor DFuns; cast w/w is no help, and we can't transform + -- a DFunUnfolding in mk_worker_unfolding + , not (exprIsTrivial rhs) -- Not x = y |> co; Wrinkle 1 + , not (isInlineUnfolding unf) -- Not INLINE things: Wrinkle 4 + , not (isUnliftedType rhs_ty) -- Not if rhs has an unlifted type; + -- see Note [Cast w/w: unlifted] + = do { (rhs_floats, work_rhs) <- prepareRhs mode top_lvl occ_fs rhs + ; uniq <- getUniqueM + ; let work_name = mkSystemVarName uniq occ_fs + work_id = mkLocalIdWithInfo work_name Many rhs_ty worker_info + + ; work_unf <- mk_worker_unfolding work_id work_rhs + ; let work_id_w_unf = work_id `setIdUnfolding` work_unf + floats = emptyFloats env + `addLetFloats` rhs_floats + `addLetFloats` unitLetFloat (NonRec work_id_w_unf work_rhs) + + triv_rhs = Cast (Var work_id_w_unf) co + + ; if postInlineUnconditionally env top_lvl bndr occ_info triv_rhs + -- Almost always True, because the RHS is trivial + -- In that case we want to eliminate the binding fast + -- We conservatively use postInlineUnconditionally so that we + -- check all the right things + then do { tick (PostInlineUnconditionally bndr) + ; return ( floats + , extendIdSubst (setInScopeFromF env floats) old_bndr $ + DoneEx triv_rhs Nothing ) } + + else do { wrap_unf <- mkLetUnfolding (sm_uf_opts mode) top_lvl InlineRhs bndr triv_rhs + ; let bndr' = bndr `setInlinePragma` mkCastWrapperInlinePrag (idInlinePragma bndr) + `setIdUnfolding` wrap_unf + floats' = floats `extendFloats` NonRec bndr' triv_rhs + ; return ( floats', setInScopeFromF env floats' ) } } + where + mode = getMode env + occ_fs = getOccFS bndr + rhs_ty = coercionLKind co + info = idInfo bndr + unf = unfoldingInfo info + + worker_info = vanillaIdInfo `setDmdSigInfo` dmdSigInfo info + `setCprSigInfo` cprSigInfo info + `setDemandInfo` demandInfo info + `setInlinePragInfo` inlinePragInfo info + `setArityInfo` arityInfo info + -- We do /not/ want to transfer OccInfo, Rules + -- Note [Preserve strictness in cast w/w] + -- and Wrinkle 2 of Note [Cast worker/wrapper] + + ----------- Worker unfolding ----------- + -- Stable case: if there is a stable unfolding we have to compose with (Sym co); + -- the next round of simplification will do the job + -- Non-stable case: use work_rhs + -- Wrinkle 3 of Note [Cast worker/wrapper] + mk_worker_unfolding work_id work_rhs + = case unf of + CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src } + | isStableSource src -> return (unf { uf_tmpl = mkCast unf_rhs (mkSymCo co) }) + _ -> mkLetUnfolding (sm_uf_opts mode) top_lvl InlineRhs work_id work_rhs + +tryCastWorkerWrapper env _ _ _ bndr rhs -- All other bindings + = return (mkFloatBind env (NonRec bndr rhs)) mkCastWrapperInlinePrag :: InlinePragma -> InlinePragma --- See Note [Cast wrappers] +-- See Note [Cast worker/wrapper] mkCastWrapperInlinePrag (InlinePragma { inl_act = act, inl_rule = rule_info }) = InlinePragma { inl_src = SourceText "{-# INLINE" , inl_inline = NoUserInlinePrag -- See Note [Wrapper NoUserInline] @@ -599,6 +670,19 @@ mkCastWrapperInlinePrag (InlinePragma { inl_act = act, inl_rule = rule_info }) wrap_act | isNeverActive act = activateDuringFinal | otherwise = act + +{- ********************************************************************* +* * + prepareBinding, prepareRhs, makeTrivial +* * +********************************************************************* -} + +prepareBinding :: SimplEnv -> TopLevelFlag + -> OutId -> OutExpr + -> SimplM (LetFloats, OutExpr) +prepareBinding env top_lvl bndr rhs + = prepareRhs (getMode env) top_lvl (getOccFS bndr) rhs + {- Note [prepareRhs] ~~~~~~~~~~~~~~~~~~~~ prepareRhs takes a putative RHS, checks whether it's a PAP or @@ -806,31 +890,32 @@ completeBind env top_lvl mb_cont old_bndr new_bndr new_rhs do { let old_info = idInfo old_bndr old_unf = unfoldingInfo old_info occ_info = occInfo old_info + mode = getMode env -- Do eta-expansion on the RHS of the binding -- See Note [Eta-expanding at let bindings] in GHC.Core.Opt.Simplify.Utils - ; (new_arity, final_rhs) <- tryEtaExpandRhs (getMode env) new_bndr new_rhs + ; (new_arity, eta_rhs) <- tryEtaExpandRhs mode new_bndr new_rhs -- Simplify the unfolding ; new_unfolding <- simplLetUnfolding env top_lvl mb_cont old_bndr - final_rhs (idType new_bndr) new_arity old_unf + eta_rhs (idType new_bndr) new_arity old_unf - ; let final_bndr = addLetBndrInfo new_bndr new_arity new_unfolding + ; let new_bndr_w_info = addLetBndrInfo new_bndr new_arity new_unfolding -- See Note [In-scope set as a substitution] - ; if postInlineUnconditionally env top_lvl final_bndr occ_info final_rhs + ; if postInlineUnconditionally env top_lvl new_bndr_w_info occ_info eta_rhs then -- Inline and discard the binding do { tick (PostInlineUnconditionally old_bndr) ; return ( emptyFloats env , extendIdSubst env old_bndr $ - DoneEx final_rhs (isJoinId_maybe new_bndr)) } + DoneEx eta_rhs (isJoinId_maybe new_bndr)) } -- Use the substitution to make quite, quite sure that the -- substitution will happen, since we are going to discard the binding - else -- Keep the binding + else -- Keep the binding; do cast worker/wrapper -- pprTrace "Binding" (ppr final_bndr <+> ppr new_unfolding) $ - return (mkFloatBind env (NonRec final_bndr final_rhs)) } + tryCastWorkerWrapper env top_lvl old_bndr occ_info new_bndr_w_info eta_rhs } addLetBndrInfo :: OutId -> ArityType -> Unfolding -> OutId addLetBndrInfo new_bndr new_arity_type new_unf diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs index 87dcd92d1e..8e5244ff4b 100644 --- a/compiler/GHC/Core/Opt/WorkWrap.hs +++ b/compiler/GHC/Core/Opt/WorkWrap.hs @@ -225,6 +225,8 @@ function will definitely get a w/w split" and that's hard to predict in advance...the logic in mkWwBodies is complex. So I've left the super-simple test, with this Note to explain. +NB: record selectors are ordinary functions, inlined iff GHC wants to, +so won't be caught by the preceding isInlineUnfolding test in tryWW. Note [Worker/wrapper for NOINLINE functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -511,12 +513,16 @@ tryWW ww_opts is_rec fn_id rhs , Just filler <- mkAbsentFiller ww_opts fn_id = return [(new_fn_id, filler)] + -- See Note [Don't w/w INLINE things] + | hasInlineUnfolding fn_id + = return [(new_fn_id, rhs)] + -- See Note [No worker/wrapper for record selectors] | isRecordSelector fn_id = return [ (new_fn_id, rhs ) ] | is_fun && is_eta_exp - = splitFun ww_opts new_fn_id fn_info wrap_dmds div cpr rhs + = splitFun ww_opts new_fn_id fn_info rhs -- See Note [Thunk splitting] | isNonRec is_rec, is_thunk @@ -526,16 +532,8 @@ tryWW ww_opts is_rec fn_id rhs = return [ (new_fn_id, rhs) ] where - fn_info = idInfo fn_id - (wrap_dmds, div) = splitDmdSig (dmdSigInfo fn_info) - - cpr_ty = getCprSig (cprSigInfo fn_info) - -- Arity of the CPR sig should match idArity when it's not a join point. - -- See Note [Arity trimming for CPR signatures] in GHC.Core.Opt.CprAnal - cpr = assertPpr (isJoinId fn_id || cpr_ty == topCprType || ct_arty cpr_ty == arityInfo fn_info) - (ppr fn_id <> colon <+> text "ct_arty:" <+> int (ct_arty cpr_ty) - <+> text "arityInfo:" <+> ppr (arityInfo fn_info)) $ - ct_cpr cpr_ty + fn_info = idInfo fn_id + (wrap_dmds, _) = splitDmdSig (dmdSigInfo fn_info) new_fn_id = zapIdUsedOnceInfo (zapIdUsageEnvInfo fn_id) -- See Note [Zapping DmdEnv after Demand Analyzer] and @@ -649,7 +647,7 @@ Consider this (#19824 comment on 15 May 21): v = ...big... g x = f v x + 1 -So `f` will generate a worker/wrapper split; and `g` (since it is small +So `f` will generate a worker/wrapper split; and `g` (since it is small) will trigger the certainlyWillInline case of splitFun. The danger is that we end up with g {- StableUnfolding = \x -> f v x + 1 -} @@ -670,22 +668,22 @@ by LitRubbish (see Note [Drop absent bindings]) so there is no great harm. --------------------- -splitFun :: WwOpts -> Id -> IdInfo -> [Demand] -> Divergence -> Cpr -> CoreExpr - -> UniqSM [(Id, CoreExpr)] -splitFun ww_opts fn_id fn_info wrap_dmds div cpr rhs +splitFun :: WwOpts -> Id -> IdInfo -> CoreExpr -> UniqSM [(Id, CoreExpr)] +splitFun ww_opts fn_id fn_info rhs = warnPprTrace (not (wrap_dmds `lengthIs` (arityInfo fn_info))) (ppr fn_id <+> (ppr wrap_dmds $$ ppr cpr)) $ do { mb_stuff <- mkWwBodies ww_opts rhs_fvs fn_id wrap_dmds use_cpr_info ; case mb_stuff of - Nothing -> return [(fn_id, rhs)] + Nothing -> -- No useful wrapper; leave the binding alone + return [(fn_id, rhs)] Just stuff | Just stable_unf <- certainlyWillInline uf_opts fn_info + -- We could make a w/w split, but in fact the RHS is small + -- See Note [Don't w/w inline small non-loop-breaker things] , let id_w_unf = fn_id `setIdUnfolding` stable_unf -- See Note [Inline pragma for certainlyWillInline] -> return [ (id_w_unf, rhs) ] - -- See Note [Don't w/w INLINE things] - -- See Note [Don't w/w inline small non-loop-breaker things] | otherwise -> do { work_uniq <- getUniqueM @@ -695,6 +693,16 @@ splitFun ww_opts fn_id fn_info wrap_dmds div cpr rhs uf_opts = so_uf_opts (wo_simple_opts ww_opts) rhs_fvs = exprFreeVars rhs + (wrap_dmds, div) = splitDmdSig (dmdSigInfo fn_info) + + cpr_ty = getCprSig (cprSigInfo fn_info) + -- Arity of the CPR sig should match idArity when it's not a join point. + -- See Note [Arity trimming for CPR signatures] in GHC.Core.Opt.CprAnal + cpr = assertPpr (isJoinId fn_id || cpr_ty == topCprType || ct_arty cpr_ty == arityInfo fn_info) + (ppr fn_id <> colon <+> text "ct_arty:" <+> int (ct_arty cpr_ty) + <+> text "arityInfo:" <+> ppr (arityInfo fn_info)) $ + ct_cpr cpr_ty + -- use_cpr_info is the CPR we w/w for. Note that we kill it for join points, -- see Note [Don't w/w join points for CPR]. use_cpr_info | isJoinId fn_id = topCpr diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs index bd02bd6fc1..55561c9cbc 100644 --- a/compiler/GHC/Core/Unfold.hs +++ b/compiler/GHC/Core/Unfold.hs @@ -972,11 +972,11 @@ certainlyWillInline opts fn_info | noinline -> Nothing -- See Note [Worker/wrapper for NOINLINE functions] | otherwise -> case guidance of - UnfNever -> Nothing + UnfNever -> Nothing UnfWhen {} -> Just (fn_unf { uf_src = src' }) -- INLINE functions have UnfWhen UnfIfGoodArgs { ug_size = size, ug_args = args } - -> do_cunf expr size args src' + -> do_cunf expr size args src' where src' = -- Do not change InlineCompulsory! case src of diff --git a/compiler/GHC/Core/Unfold/Make.hs b/compiler/GHC/Core/Unfold/Make.hs index e911d722ee..378d5a6131 100644 --- a/compiler/GHC/Core/Unfold/Make.hs +++ b/compiler/GHC/Core/Unfold/Make.hs @@ -230,7 +230,7 @@ The semantics of an INLINE pragma is the `UnfoldingGuidance`.) In the example, x's ug_arity is 0, so we should inline it at every use -site. It's rare to have such an INLINE pragma (usually INLINE Is on +site. It's rare to have such an INLINE pragma (usually INLINE is on functions), but it's occasionally very important (#15578, #15519). In #15519 we had something like x = case (g a b) of I# r -> T r diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs index 55ff3f9335..7c78c1928b 100644 --- a/compiler/GHC/Types/Id.hs +++ b/compiler/GHC/Types/Id.hs @@ -94,7 +94,7 @@ module GHC.Types.Id ( -- ** Reading 'IdInfo' fields idArity, idCallArity, idFunRepArity, - idUnfolding, realIdUnfolding, + idUnfolding, realIdUnfolding, hasInlineUnfolding, idSpecialisation, idCoreRules, idHasRules, idCafInfo, idLFInfo_maybe, idOneShotInfo, idStateHackOneShotInfo, @@ -124,7 +124,8 @@ module GHC.Types.Id ( import GHC.Prelude import GHC.Core ( CoreRule, isStableUnfolding, evaldUnfolding, - isCompulsoryUnfolding, Unfolding( NoUnfolding ) ) + isCompulsoryUnfolding, isInlineUnfolding, + Unfolding( NoUnfolding ) ) import GHC.Types.Id.Info import GHC.Types.Basic @@ -721,6 +722,12 @@ idUnfolding id where info = idInfo id +hasInlineUnfolding :: Id -> Bool +-- ^ True of a non-loop-breaker Id that has a /stable/ unfolding that is +-- (a) always inlined; that is, with an `UnfWhen` guidance, or +-- (b) a DFunUnfolding which never needs to be inlined +hasInlineUnfolding id = isInlineUnfolding (idUnfolding id) + realIdUnfolding :: Id -> Unfolding -- Expose the unfolding if there is one, including for loop breakers realIdUnfolding id = unfoldingInfo (idInfo id) |