Inline partially-applied wrappers

Suppose we have

```
data Node a = Node2 !Int a a | Node3 !Int a a a
instance Traversable Node where
  traverse f (Node2 s x y) = Node2 s <$> f x <*> f y
  ...

```

Since `Node2` is partially applied, we wouldn't inline its
wrapper.  The result was that we'd box up the `Int#` to put
the box in the closure passed to `fmap`. We now allow the wrapper
to inline when partially applied, so GHC stores the `Int#`
directly in the closure.

Reviewers: rwbarton, mpickering, simonpj, austin, bgamari

Reviewed By: simonpj, bgamari

Subscribers: mpickering, thomie

Differential Revision: https://phabricator.haskell.org/D2891

GHC Trac Issues: #12990

4 files changed, 40 insertions, 2 deletions

diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr
index ff1047db84..797c6c7776 100644
--- a/testsuite/tests/deSugar/should_compile/T2431.stderr
+++ b/testsuite/tests/deSugar/should_compile/T2431.stderr
@@ -9,7 +9,7 @@ T2431.$WRefl [InlPrag=INLINE] :: forall a. a :~: a
  Str=m,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
-         Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=False)
+         Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=False)
          Tmpl= \ (@ a) ->
                  T2431.Refl @ a @ a @~ (<a>_N :: (a :: *) GHC.Prim.~# (a :: *))}]
 T2431.$WRefl =
diff --git a/testsuite/tests/perf/should_run/T12990.hs b/testsuite/tests/perf/should_run/T12990.hs
new file mode 100644
index 0000000000..f7655ac96a
--- /dev/null
+++ b/testsuite/tests/perf/should_run/T12990.hs
@@ -0,0 +1,28 @@
+-- We used to inline constructor wrapper functions only when fully applied.
+-- This led to unnecessary boxing when partially applying to unpacked fields.
+
+module Main where
+import Control.DeepSeq
+import Data.Functor.Identity
+import Control.Exception (evaluate)
+
+data AList = Cons !Int !Int !Int !Int !Int !Int !Int !Int !Int AList | Nil
+
+-- We need to write this instance manually because the Generic-derived
+-- instance allocates a ton of intermediate junk, obscuring the interesting
+-- differences.
+instance NFData AList where
+  rnf Nil = ()
+  rnf (Cons _1 _2 _3 _4 _5 _6 _7 _8 _9 xs) = rnf xs
+
+-- If GHC is allowed to specialize it to Identity, the partial application of
+-- Cons will become a fully saturated one, defeating the test. So we NOINLINE
+-- it.
+buildalist :: Applicative f => Int -> f AList
+buildalist n
+  | n <= 0 = pure Nil
+  | otherwise = Cons n (n+1) (n+2) (n+3) (n+4) (n+5) (n+6) (n+7) (n+8) <$>
+                  buildalist (n - 1)
+{-# NOINLINE buildalist #-}
+
+main = evaluate . rnf . runIdentity $ buildalist 100000
diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T
index 89ae3ecc70..333970ca57 100644
--- a/testsuite/tests/perf/should_run/all.T
+++ b/testsuite/tests/perf/should_run/all.T
@@ -460,3 +460,13 @@ test('T13001',
       only_ways(['normal'])],
      compile_and_run,
      ['-O2'])
+
+test('T12990',
+    [stats_num_field('bytes allocated',
+                     [ (wordsize(64), 21640904, 5) ]),
+                     # 2017-01-03     34440936  w/o inlining unsaturated
+                     #                          constructor wrappers
+                     # 2017-01-03     21640904 inline wrappers
+     only_ways(['normal'])],
+    compile_and_run,
+    ['-O2'])
diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr
index 4598b3e8d1..2b0984c8d5 100644
--- a/testsuite/tests/simplCore/should_compile/T7360.stderr
+++ b/testsuite/tests/simplCore/should_compile/T7360.stderr
@@ -10,7 +10,7 @@ T7360.$WFoo3 [InlPrag=INLINE] :: Int -> Foo
  Str=<S,U>m3,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
-         Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False)
+         Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (dt [Occ=Once!] :: Int) ->
                  case dt of { GHC.Types.I# dt [Occ=Once] -> T7360.Foo3 dt }}]
 T7360.$WFoo3 =