Be a bit more eager to inline in a strict context

If we see f (g x), and f is strict, we want to be a bit more eager to
inline g, because it may well expose an eval (on x perhaps) that can
be eliminated or shared.

I saw this in nofib boyer2, function RewriteFuns.onewayunify1.  It
showed up as a consequence of the preceding patch that makes the
simplifier do less work (Trac #13379).  We had

   f d (g x)

where f was a class-op. Previously we simplified both d and
(g x) with a RuleArgCtxt (making g a bit more eager to inline).
But now we simplify only d that way, then fire the rule, and
only then simplify (g x).  Firing the rule produces a strict
funciion, so we want to make a strict function encourage
inlining a bit.

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 }