[commit: ghc] wip/nested-cpr: Inline the datacon wrapper more aggressively (0fadbc1)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nested-cpr
Link       : http://ghc.haskell.org/trac/ghc/changeset/0fadbc19284a317c5f16d01f9ed21f260b72c892/ghc

>---------------------------------------------------------------

commit 0fadbc19284a317c5f16d01f9ed21f260b72c892
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Tue Jan 14 10:18:48 2014 +0000

    Inline the datacon wrapper more aggressively
    
    so that the CPR analysis find the real constructor and can return a
    nested CPR result.
    
    An alternative would be to look through the unfolding and analize that
    (but that would only be a good idea if the wrapper is going to be
    inlined afterwards), or special-case wrappers in the demand analyzer.
    Both not very nice.
    
    According to nofib: The impact of this is (on code size and allocations)
    is ... nil.


>---------------------------------------------------------------

0fadbc19284a317c5f16d01f9ed21f260b72c892
 compiler/basicTypes/MkId.lhs    |    2 +-
 compiler/coreSyn/CoreUnfold.lhs |   31 +++++++++++++++++++++++++++++++
 2 files changed, 32 insertions(+), 1 deletion(-)

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index b77d31c..14a8d6f 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -513,7 +513,7 @@ mkDataConRep dflags fam_envs wrap_name data_con
     	         --      ...(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
+             wrap_unf = mkDataConWrapUnfolding wrap_arity wrap_rhs
              wrap_tvs = (univ_tvs `minusList` map fst eq_spec) ++ ex_tvs
     	     wrap_rhs = mkLams wrap_tvs $ 
     	                mkLams wrap_args $
diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs
index a219de8..2df8139 100644
--- a/compiler/coreSyn/CoreUnfold.lhs
+++ b/compiler/coreSyn/CoreUnfold.lhs
@@ -29,6 +29,7 @@ module CoreUnfold (
         mkUnfolding, mkCoreUnfolding,
 	mkTopUnfolding, mkSimpleUnfolding,
 	mkInlineUnfolding, mkInlinableUnfolding, mkWwInlineRule,
+        mkDataConWrapUnfolding,
 	mkCompulsoryUnfolding, mkDFunUnfolding,
 
 	interestingArg, ArgSummary(..),
@@ -127,6 +128,16 @@ mkInlineUnfolding mb_arity expr
               
     boring_ok = inlineBoringOk expr'
 
+mkDataConWrapUnfolding :: Arity -> CoreExpr -> Unfolding
+mkDataConWrapUnfolding arity expr
+  = mkCoreUnfolding InlineStable
+                    True
+                    expr' arity
+                    (UnfWhen needSaturated boringCxtOk)
+                    -- Note [Inline data constructor wrappers aggresively]
+  where
+    expr' = simpleOptExpr expr
+
 mkInlinableUnfolding :: DynFlags -> CoreExpr -> Unfolding
 mkInlinableUnfolding dflags expr
   = mkUnfolding dflags InlineStable True is_bot expr'
@@ -199,6 +210,26 @@ This can occasionally mean that the guidance is very pessimistic;
 it gets fixed up next round.  And it should be rare, because large
 let-bound things that are dead are usually caught by preInlineUnconditionally
 
+Note [Inline data constructor wrappers aggresively]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The wrappers for strict data type constructors are to be inlined even in
+a boring context. This increases the chance that the demand analyzer will
+see the real constructor and return a nested CPR property.
+
+For example:
+    data P a = P !a !b
+    f :: Int -> P Int Int
+    f x = P x x
+previously, the demand analyzer would only see
+    f x = $WP x x
+and infer a strictness signature of "<S,U>m(,)", i.e. a non-nested CPR property.
+
+But if we inline $WP, we get
+    f x = case x of _ -> P x x
+and we would get "<S,U>,m(t(),t())", i.e. a nested CPR property.
+
+A real world example of this issue is the function mean in [ticket:2289#comment:1].
+
 
 %************************************************************************
 %*									*