[commit: ghc] wip/dmd-arity: Add a test case (629fa97)

[git at git.haskell.org]

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

On branch  : wip/dmd-arity
Link       : http://ghc.haskell.org/trac/ghc/changeset/629fa9787548601b5c15cc1796d78e3ce1a49368/ghc

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

commit 629fa9787548601b5c15cc1796d78e3ce1a49368
Author: Sebastian Graf <sebastian.graf at kit.edu>
Date:   Fri Feb 8 14:13:20 2019 +0100

    Add a test case
    
    This substantiates comments about demand analysis of trivial right-hand
    sides and its interaction with CoreArity.


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

629fa9787548601b5c15cc1796d78e3ce1a49368
 compiler/coreSyn/CoreArity.hs                    |  5 +++++
 compiler/stranal/DmdAnal.hs                      | 16 ++++++----------
 testsuite/tests/stranal/sigs/NewtypeArity.hs     | 10 ++++++++++
 testsuite/tests/stranal/sigs/NewtypeArity.stderr | 18 ++++++++++++++++++
 testsuite/tests/stranal/sigs/all.T               |  1 +
 5 files changed, 40 insertions(+), 10 deletions(-)

diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs
index 37454eb..828c1c7 100644
--- a/compiler/coreSyn/CoreArity.hs
+++ b/compiler/coreSyn/CoreArity.hs
@@ -179,6 +179,11 @@ Why is this important?  Because
   - In CorePrep we use etaExpand on each rhs, so that the visible lambdas
     actually match that arity, which in turn means
     that the StgRhs has the right number of lambdas
+  - In demand analysis, we want to analyse trivial right-hand sides like in
+    let y = x |> co in ... as if we looked directly into the definition of x.
+    This is the case if y has the same arity as x.
+    See Note [Newtype arity] and
+    Note [Demand analysis for trivial right-hand sides] in DmdAnal.hs.
 
 An alternative would be to do the eta-expansion in TidyPgm, at least
 for top-level bindings, in which case we would not need the trim_arity
diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs
index bab6f18..90dcf08 100644
--- a/compiler/stranal/DmdAnal.hs
+++ b/compiler/stranal/DmdAnal.hs
@@ -704,19 +704,15 @@ Another win for join points!  Trac #13543.
 Note [Demand analysis for trivial right-hand sides]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider
-        foo = plusInt |> co
+    foo = plusInt |> co
 where plusInt is an arity-2 function with known strictness.  Clearly
 we want plusInt's strictness to propagate to foo!  But because it has
 no manifest lambdas, it won't do so automatically, and indeed 'co' might
-have type (Int->Int->Int) ~ T, so we *can't* eta-expand.  So we have a
-special case for right-hand sides that are "trivial", namely variables,
-casts, type applications, and the like.
-
-Note that this can mean that 'foo' has an arity that is smaller than that
-indicated by its demand info.  e.g. if co :: (Int->Int->Int) ~ T, then
-foo's arity will be zero (see Note [exprArity invariant] in CoreArity),
-but its demand signature will be that of plusInt. A small example is the
-test case of Trac #8963.
+have type (Int->Int->Int) ~ T.
+
+Fortunately, CoreArity gives 'foo' arity 2 and all is well (see the definition
+of 'manifestArity' and Note [Newtype arity] in CoreArity)! A small example is
+the test case NewtypeArity.
 
 
 Note [Product demands for function body]
diff --git a/testsuite/tests/stranal/sigs/NewtypeArity.hs b/testsuite/tests/stranal/sigs/NewtypeArity.hs
new file mode 100644
index 0000000..3a8e96b
--- /dev/null
+++ b/testsuite/tests/stranal/sigs/NewtypeArity.hs
@@ -0,0 +1,10 @@
+-- | 't' and 't2' should have a strictness signature for arity 2 here.
+module Test where
+
+newtype T = MkT (Int -> Int -> Int)
+
+t :: T
+t = MkT (\a b -> a + b)
+
+t2 :: T
+t2 = MkT (+)
diff --git a/testsuite/tests/stranal/sigs/NewtypeArity.stderr b/testsuite/tests/stranal/sigs/NewtypeArity.stderr
new file mode 100644
index 0000000..08ce83f
--- /dev/null
+++ b/testsuite/tests/stranal/sigs/NewtypeArity.stderr
@@ -0,0 +1,18 @@
+
+==================== Strictness signatures ====================
+Test.$tc'MkT: m
+Test.$tcT: m
+Test.$trModule: m
+Test.t: <S,1*U(U)><S,1*U(U)>m
+Test.t2: <S,1*U(U)><S,1*U(U)>m
+
+
+
+==================== Strictness signatures ====================
+Test.$tc'MkT: m
+Test.$tcT: m
+Test.$trModule: m
+Test.t: <S,1*U(U)><S,1*U(U)>m
+Test.t2: <S,1*U(U)><S,1*U(U)>m
+
+
diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T
index 091a4f4..fca319f 100644
--- a/testsuite/tests/stranal/sigs/all.T
+++ b/testsuite/tests/stranal/sigs/all.T
@@ -17,3 +17,4 @@ test('BottomFromInnerLambda', normal, compile, [''])
 test('DmdAnalGADTs', normal, compile, [''])
 test('T12370', normal, compile, [''])
 test('CaseBinderCPR', normal, compile, [''])
+test('NewtypeArity', normal, compile, [''])