diff options
| -rw-r--r-- | compiler/simplCore/SimplUtils.hs | 2 | ||||
| -rw-r--r-- | compiler/simplCore/Simplify.hs | 26 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/T12603.stdout | 2 |
3 files changed, 23 insertions, 7 deletions
diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index 3ebdae479b..a2c7b8b855 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -551,6 +551,8 @@ interestingCallContext cont -- If f has an INLINE prag we need to give it some -- motivation to inline. See Note [Cast then apply] -- in CoreUnfold + + interesting (StrictArg _ BoringCtxt _) = RhsCtxt interesting (StrictArg _ cci _) = cci interesting (StrictBind {}) = BoringCtxt interesting (Stop _ cci) = cci diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 4f41d0dd49..9bfdd1ede9 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -1807,7 +1807,7 @@ rebuildCall env info@(ArgInfo { ai_encl = encl_rules, ai_type = fun_ty | str -- Strict argument = -- pprTrace "Strict Arg" (ppr arg $$ ppr (seIdSubst env) $$ ppr (seInScope env)) $ simplExprF (arg_se `setFloats` env) arg - (StrictArg info' cci cont) + (StrictArg info' cci_strict cont) -- Note [Shadowing] | otherwise -- Lazy argument @@ -1816,13 +1816,27 @@ rebuildCall env info@(ArgInfo { ai_encl = encl_rules, ai_type = fun_ty -- have to be very careful about bogus strictness through -- floating a demanded let. = do { arg' <- simplExprC (arg_se `setInScopeAndZapFloats` env) arg - (mkLazyArgStop (funArgTy fun_ty) cci) + (mkLazyArgStop arg_ty cci_lazy) ; rebuildCall env (addValArgTo info' arg') cont } where - info' = info { ai_strs = strs, ai_discs = discs } - cci | encl_rules = RuleArgCtxt - | disc > 0 = DiscArgCtxt -- Be keener here - | otherwise = BoringCtxt -- Nothing interesting + info' = info { ai_strs = strs, ai_discs = discs } + arg_ty = funArgTy fun_ty + + -- Use this for lazy arguments + cci_lazy | encl_rules = RuleArgCtxt + | disc > 0 = DiscArgCtxt -- Be keener here + | otherwise = BoringCtxt -- Nothing interesting + + -- ..and this for strict arguments + cci_strict | encl_rules = RuleArgCtxt + | disc > 0 = DiscArgCtxt + | otherwise = RhsCtxt + -- Why RhsCtxt? if we see f (g x) (h x), and f is strict, we + -- want to be a bit more eager to inline g, because it may + -- expose an eval (on x perhaps) that can be eliminated or + -- shared. I saw this in nofib 'boyer2', RewriteFuns.onewayunify1 + -- It's worth an 18% improvement in allocation for this + -- particular benchmark; 5% on 'mate' and 1.3% on 'multiplier' ---------- No further useful info, revert to generic rebuild ------------ rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont diff --git a/testsuite/tests/simplCore/should_compile/T12603.stdout b/testsuite/tests/simplCore/should_compile/T12603.stdout index 277aa18f6b..57a2a246e2 100644 --- a/testsuite/tests/simplCore/should_compile/T12603.stdout +++ b/testsuite/tests/simplCore/should_compile/T12603.stdout @@ -1 +1 @@ -lvl = case GHC.Real.$wf1 2# 8# of v { __DEFAULT -> GHC.Types.I# v } + = case GHC.Real.$wf1 2# 8# of ww4 { __DEFAULT -> GHC.Types.I# ww4 } |