Commit 2be364ac authored by David Feuer's avatar David Feuer Committed by David Feuer

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
parent 8b15fc42
......@@ -466,6 +466,32 @@ newtype DataConBoxer = DCB ([Type] -> [Var] -> UniqSM ([Var], [CoreBind]))
-- Bind these src-level vars, returning the
-- rep-level vars to bind in the pattern
{-
Note [Inline partially-applied constructor wrappers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We allow the wrapper to inline when partially applied to avoid
boxing values unnecessarily. For example, consider
data Foo a = Foo !Int a
instance Traversable Foo where
traverse f (Foo i a) = Foo i <$> f a
This desugars to
traverse f foo = case foo of
Foo i# a -> let i = I# i#
in map ($WFoo i) (f a)
If the wrapper `$WFoo` is not inlined, we get a fruitless reboxing of `i`.
But if we inline the wrapper, we get
map (\a. case i of I# i# a -> Foo i# a) (f a)
and now case-of-known-constructor eliminates the redundant allocation.
-}
mkDataConRep :: DynFlags
-> FamInstEnvs
-> Name
......@@ -498,16 +524,16 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
wrap_arg_dmds = map mk_dmd arg_ibangs
mk_dmd str | isBanged str = evalDmd
| otherwise = topDmd
-- The Cpr info can be important inside INLINE rhss, where the
-- wrapper constructor isn't inlined.
-- And the argument strictness can be important too; we
-- may not inline a constructor when it is partially applied.
-- For example:
-- data W = C !Int !Int !Int
-- ...(let w = C x in ...(w p q)...)...
-- we want to see that w is strict in its two arguments
wrap_unf = mkInlineUnfolding (Just wrap_arity) wrap_rhs
-- The wrapper will usually be inlined (see wrap_unf), so its
-- strictness and CPR info is usually irrelevant. But this is
-- not always the case; GHC may choose not to inline it. In
-- particular, the wrapper constructor is not inlined inside
-- an INLINE rhs or when it is not applied to any arguments.
-- See Note [Inline partially-applied constructor wrappers]
-- Passing Nothing here allows the wrapper to inline when
-- unsaturated.
wrap_unf = mkInlineUnfolding Nothing wrap_rhs
wrap_tvs = (univ_tvs `minusList` map eqSpecTyVar eq_spec) ++ ex_tvs
wrap_rhs = mkLams wrap_tvs $
mkLams wrap_args $
......
......@@ -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 =
......
-- 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
......@@ -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'])
......@@ -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 =
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment