diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2018-01-09 16:11:44 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2018-01-09 16:25:53 +0000 |
| commit | 1c1e46c1292f4ac69275770ed588401535abec45 (patch) | |
| tree | 8fdb9a86f9b180c4b11a327e58e0637a92feedd3 /compiler/simplCore/Simplify.hs | |
| parent | 66ff794fedf6e81e727dc8f651e63afe6f2a874b (diff) | |
| download | haskell-1c1e46c1292f4ac69275770ed588401535abec45.tar.gz | |
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.
Diffstat (limited to 'compiler/simplCore/Simplify.hs')
| -rw-r--r-- | compiler/simplCore/Simplify.hs | 17 |
1 files changed, 8 insertions, 9 deletions
diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 3f60257d04..b123055387 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 -> |