[commit: ghc] master: preInlineUnconditionally is ok for INLINEABLE (1c1e46c)
git at git.haskell.org
git at git.haskell.org
Wed Jan 10 08:21:10 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/1c1e46c1292f4ac69275770ed588401535abec45/ghc
>---------------------------------------------------------------
commit 1c1e46c1292f4ac69275770ed588401535abec45
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Tue Jan 9 16:11:44 2018 +0000
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.
>---------------------------------------------------------------
1c1e46c1292f4ac69275770ed588401535abec45
compiler/simplCore/SimplUtils.hs | 54 ++++++++++++++++++++++++++--------------
compiler/simplCore/Simplify.hs | 17 ++++++-------
2 files changed, 43 insertions(+), 28 deletions(-)
diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs
index dfe8b62..d86adbb 100644
--- a/compiler/simplCore/SimplUtils.hs
+++ b/compiler/simplCore/SimplUtils.hs
@@ -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 at 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
diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs
index 3f60257..b123055 100644
--- a/compiler/simplCore/Simplify.hs
+++ b/compiler/simplCore/Simplify.hs
@@ -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 ->
More information about the ghc-commits
mailing list