Commit 1c1e46c1 authored by Simon Peyton Jones's avatar Simon Peyton Jones

preInlineUnconditionally is ok for INLINEABLE

When debugging Trac #14650, I found a place where we had

    let {-# INLINEABLE f #-}
        f = BIG
    in f 7

but 'f' wasn't getting inlined at its unique call site.
There's a good reason for that with INLINE things, which
should only inline when saturated, but not  for INILNEABLE
things.

This patch narrows the case where preInlineUnconditionally
gives up.  It significantly shortens (and improves) the code
for #14650.
parent 66ff794f
......@@ -1082,6 +1082,11 @@ want PreInlineUnconditionally to second-guess it. A live example is
Trac #3736.
c.f. Note [Stable unfoldings and postInlineUnconditionally]
NB: if the pragama is INLINEABLE, then we don't want to behave int
this special way -- an INLINEABLE pragam just says to GHC "inline this
if you like". But if there is a unique occurrence, we want to inline
the stable unfolding, not the RHS.
Note [Top-level bottoming Ids]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Don't inline top-level Ids that are bottoming, even if they are used just
......@@ -1095,33 +1100,44 @@ is a term (not a coercion) so we can't necessarily inline the latter in
the former.
-}
preInlineUnconditionally :: SimplEnv -> TopLevelFlag -> InId -> InExpr -> Bool
preInlineUnconditionally
:: SimplEnv -> TopLevelFlag -> InId
-> InExpr -> StaticEnv -- These two go together
-> Maybe SimplEnv -- Returned env has extended substitution
-- Precondition: rhs satisfies the let/app invariant
-- See Note [CoreSyn let/app invariant] in CoreSyn
-- 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
| not pre_inline_unconditionally = False
| not active = False
| isStableUnfolding (idUnfolding bndr) = False -- Note [Stable unfoldings and preInlineUnconditionally]
| isTopLevel top_lvl && isBottomingId bndr = False -- Note [Top-level bottoming Ids]
| isCoVar bndr = False -- Note [Do not inline CoVars unconditionally]
| isExitJoinId bndr = False
| otherwise = case idOccInfo bndr of
IAmDead -> True -- Happens in ((\x.1) v)
occ@OneOcc { occ_one_br = True }
-> try_once (occ_in_lam occ)
(occ_int_cxt occ)
_ -> False
preInlineUnconditionally env top_lvl bndr rhs rhs_env
| not pre_inline_unconditionally = Nothing
| not active = Nothing
| isTopLevel top_lvl && isBottomingId bndr = Nothing -- Note [Top-level bottoming Ids]
| isCoVar bndr = Nothing -- Note [Do not inline CoVars unconditionally]
| isExitJoinId bndr = Nothing
| not (one_occ (idOccInfo bndr)) = Nothing
| not (isStableUnfolding unf) = Just (extend_subst_with rhs)
-- Note [Stable unfoldings and preInlineUnconditionally]
| isInlinablePragma inline_prag
, Just inl <- maybeUnfoldingTemplate unf = Just (extend_subst_with inl)
| otherwise = Nothing
where
unf = idUnfolding bndr
extend_subst_with inl_rhs = extendIdSubst env bndr (mkContEx rhs_env inl_rhs)
one_occ IAmDead = True -- Happens in ((\x.1) v)
one_occ (OneOcc { occ_one_br = True -- One textual occurrence
, occ_in_lam = in_lam
, occ_int_cxt = int_cxt })
| not in_lam = isNotTopLevel top_lvl || early_phase
| otherwise = int_cxt && canInlineInLam rhs
one_occ _ = False
pre_inline_unconditionally = gopt Opt_SimplPreInlining (seDynFlags env)
mode = getMode env
active = isActive (sm_phase mode) act
active = isActive (sm_phase mode) (inlinePragmaActivation inline_prag)
-- See Note [pre/postInlineUnconditionally in gentle mode]
act = idInlineActivation bndr
try_once in_lam int_cxt -- There's one textual occurrence
| not in_lam = isNotTopLevel top_lvl || early_phase
| otherwise = int_cxt && canInlineInLam rhs
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
......
......@@ -196,11 +196,10 @@ simplRecOrTopPair :: SimplEnv
-> SimplM (SimplFloats, SimplEnv)
simplRecOrTopPair env top_lvl is_rec mb_cont old_bndr new_bndr rhs
| preInlineUnconditionally env top_lvl old_bndr rhs
| Just env' <- preInlineUnconditionally env top_lvl old_bndr rhs env
= trace_bind "pre-inline-uncond" $
do { tick (PreInlineUnconditionally old_bndr)
; return ( emptyFloats env
, extendIdSubst env old_bndr (mkContEx env rhs)) }
; return ( emptyFloats env, env' ) }
| Just cont <- mb_cont
= ASSERT( isNotTopLevel top_lvl && isJoinId new_bndr )
......@@ -1368,11 +1367,11 @@ simplNonRecE :: SimplEnv
-- the call to simplLam in simplExprF (Lam ...)
simplNonRecE env bndr (rhs, rhs_se) (bndrs, body) cont
| ASSERT( isId bndr && not (isJoinId bndr) )
preInlineUnconditionally env NotTopLevel bndr rhs
| ASSERT( isId bndr && not (isJoinId bndr) ) True
, Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs rhs_se
= do { tick (PreInlineUnconditionally bndr)
; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $
simplLam (extendIdSubst env bndr (mkContEx rhs_se rhs)) bndrs body cont }
simplLam env' bndrs body cont }
-- Deal with strict bindings
| isStrictId bndr -- Includes coercions
......@@ -1461,10 +1460,10 @@ simplNonRecJoinPoint :: SimplEnv -> InId -> InExpr
-> InExpr -> SimplCont
-> SimplM (SimplFloats, OutExpr)
simplNonRecJoinPoint env bndr rhs body cont
| ASSERT( isJoinId bndr )
preInlineUnconditionally env NotTopLevel bndr rhs
| ASSERT( isJoinId bndr ) True
, Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs env
= do { tick (PreInlineUnconditionally bndr)
; simplExprF (extendIdSubst env bndr (mkContEx env rhs)) body cont }
; simplExprF env' body cont }
| otherwise
= wrapJoinCont env cont $ \ env cont ->
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment