Do not eta-expand in SimplGentlwip/T9020

Eta-expansion can seriously blow up the size of the code, if there are
newtypes and coercions involved; see #9020 for a particularly good
example.

It may work out well in a full simplifier phase, when the additional
coercions can be optimized away, e.g. after inlining. But the gentle
phase does less, in particular no inlining, so chances are high that we
will blow up our code for on good reason.

If this change works out, there is no need for #10319 anymore.

2 files changed, 22 insertions, 33 deletions

diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs
index 0fd929a2a6..38ba186e8a 100644
--- a/compiler/simplCore/SimplCore.hs
+++ b/compiler/simplCore/SimplCore.hs
@@ -179,9 +179,11 @@ getCoreToDo dflags
                                   , sm_names = ["Gentle"]
                                   , sm_rules = rules_on   -- Note [RULEs enabled in SimplGently]
                                   , sm_inline = False
-                                  , sm_case_case = False })
-                          -- Don't do case-of-case transformations.
-                          -- This makes full laziness work better
+                                  , sm_case_case = False
+                                      -- Don't do case-of-case transformations.
+                                      -- This makes full laziness work better
+                                  , sm_eta_expand = False})
+                                      -- Note [Do not eta-expand in SimplGently]
 
     -- New demand analyser
     demand_analyser = (CoreDoPasses ([
@@ -946,3 +948,14 @@ transferIdInfo exported_id local_id
                                (specInfo local_info)
         -- Remember to set the function-name field of the
         -- rules as we transfer them from one function to another
+
+-- Note [Do not eta-expand in SimplGently]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- Eta-expansion can seriously blow up the size of the code, if there are
+-- newtypes and coercions involved; see #9020 for a particularly good example.
+--
+-- It may work out well in a full simplifier phase, when the additional
+-- coercions can be optimized away, e.g. after inlining. But the gentle phase
+-- does less, in particular no inlining, so chances are high that we will blow
+-- up our code for on good reason.
diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs
index 4c469d111f..777eae2b5b 100644
--- a/compiler/simplCore/SimplUtils.hs
+++ b/compiler/simplCore/SimplUtils.hs
@@ -1273,7 +1273,7 @@ tryEtaExpandRhs env bndr rhs
 
        ; WARN( new_arity < old_id_arity,
                (ptext (sLit "Arity decrease:") <+> (ppr bndr <+> ppr old_id_arity
-                <+> ppr old_arity <+> ppr new_arity) $$ ppr new_rhs) )
+                <+> ppr old_manifest_arity <+> ppr new_arity) $$ ppr new_rhs) )
                         -- Note [Arity decrease] in Simplify
          return (new_arity, new_rhs) }
   where
@@ -1282,17 +1282,17 @@ tryEtaExpandRhs env bndr rhs
       = return (exprArity rhs, rhs)
 
       | sm_eta_expand (getMode env)      -- Provided eta-expansion is on
-      , let new_arity1 = findRhsArity dflags bndr rhs old_arity
+      , let new_arity1 = findRhsArity dflags bndr rhs old_manifest_arity
             new_arity2 = idCallArity bndr
             new_arity  = max new_arity1 new_arity2
-      , new_arity > old_arity      -- And the current manifest arity isn't enough
+      , new_arity > old_manifest_arity      -- And the current manifest arity isn't enough
       = do { tick (EtaExpansion bndr)
            ; return (new_arity, etaExpand new_arity rhs) }
       | otherwise
-      = return (old_arity, rhs)
+      = return (old_manifest_arity, rhs)
 
-    old_arity    = exprArity rhs -- See Note [Do not expand eta-expand PAPs]
-    old_id_arity = idArity bndr
+    old_manifest_arity = manifestArity rhs
+    old_id_arity       = idArity bndr
 
 {-
 Note [Eta-expanding at let bindings]
@@ -1319,30 +1319,6 @@ because then 'genMap' will inline, and it really shouldn't: at least
 as far as the programmer is concerned, it's not applied to two
 arguments!
 
-Note [Do not eta-expand PAPs]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We used to have old_arity = manifestArity rhs, which meant that we
-would eta-expand even PAPs.  But this gives no particular advantage,
-and can lead to a massive blow-up in code size, exhibited by Trac #9020.
-Suppose we have a PAP
-    foo :: IO ()
-    foo = returnIO ()
-Then we can eta-expand do
-    foo = (\eta. (returnIO () |> sym g) eta) |> g
-where
-    g :: IO () ~ State# RealWorld -> (# State# RealWorld, () #)
-
-But there is really no point in doing this, and it generates masses of
-coercions and whatnot that eventually disappear again. For T9020, GHC
-allocated 6.6G beore, and 0.8G afterwards; and residency dropped from
-1.8G to 45M.
-
-But note that this won't eta-expand, say
-  f = \g -> map g
-Does it matter not eta-expanding such functions?  I'm not sure.  Perhaps
-strictness analysis will have less to bite on?
-
-
 ************************************************************************
 *                                                                      *
 \subsection{Floating lets out of big lambdas}