[commit: ghc] wip/nested-cpr: Note [Recursion and nested cpr] and test case (161d0ce)

[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/161d0ceaf07bb7ebf979f1879c033baf0f41d04f/ghc

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

commit 161d0ceaf07bb7ebf979f1879c033baf0f41d04f
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Tue Jan 21 13:56:14 2014 +0000

    Note [Recursion and nested cpr] and test case
    
    the reason why we remove the converging flag of LoopBreakers is actually
    non-obvious, and has little to do with the termination analysis per se.
    Document that with an extensive note and guard it with two test cases.


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

161d0ceaf07bb7ebf979f1879c033baf0f41d04f
 compiler/stranal/DmdAnal.lhs                       |   40 ++++++++++++++++++++
 testsuite/tests/stranal/should_run/Stream.hs       |   13 +++++++
 testsuite/tests/stranal/should_run/all.T           |    1 +
 testsuite/tests/stranal/sigs/StreamSig.hs          |   11 ++++++
 .../{InfiniteCPRDepth0.stderr => StreamSig.stderr} |    2 +-
 testsuite/tests/stranal/sigs/all.T                 |    1 +
 6 files changed, 67 insertions(+), 1 deletion(-)

diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index 7dec582..d25999e 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -1160,6 +1160,7 @@ extendAnalEnv top_lvl env var sig
   = env { ae_sigs = extendSigEnv top_lvl (ae_sigs env) var sig' }
   where
   sig' | isWeakLoopBreaker (idOccInfo var) = sigMayDiverge sig
+             -- Note [Recursion and nested CPR]
        | isUnLiftedType (idType var)       = convergeSig sig
        | otherwise                         = sig
 
@@ -1283,3 +1284,42 @@ of the Id, and start from "bottom".  Nowadays the Id can have a current
 strictness, because interface files record strictness for nested bindings.
 To know when we are in the first iteration, we look at the ae_virgin
 field of the AnalEnv.
+
+Note [Recursion and nested cpr]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+In extendAnalEnv, we remove possible definite convergence information from loop
+breakers.
+
+This is *not* required to make termination analysis sound: It would be fine
+without this, since we initialize the fixed point iteration with definite
+divergence, and this is sufficient to make sure that, for example, a
+tail-recursive function is not going to be considered terminating.
+
+But we need to do it to avoid the nested CPR w/w-transformation from going
+horribly wrong. Consider this code (also in tests/stranal/sigs/StreamSig.hs):
+
+    data Stream a = Stream a (Stream a)
+    forever :: a -> Stream a
+    forever x = Stream x (forever x)
+
+This should deserve a CPR information of
+
+   tm(,tm(,))
+
+(or deeper, as you wish) because clearly it terminates arbitrarily deep. But if
+we gave it that signature, we would generate the following worker:
+
+  $wforever x = case $wforever x of
+    (# ww1, ww2, ww3 #) -> (# x, ww1, Stream ww2 ww3 #)
+
+which will obviously diverge. By killing the convergence flag for loop breakers
+we ensure that the CPR information is
+
+   tm(,m(,))
+
+and the worker is
+
+  $wforever x = (# x, case $wforever x of (# a, b#) -> Stream a b #)
+
+which is fine (and will later be further simplified).
diff --git a/testsuite/tests/stranal/should_run/Stream.hs b/testsuite/tests/stranal/should_run/Stream.hs
new file mode 100644
index 0000000..5e3555c
--- /dev/null
+++ b/testsuite/tests/stranal/should_run/Stream.hs
@@ -0,0 +1,13 @@
+-- Adapted from symalg/RealM.hs's treeFrom
+
+data Stream a = Stream a (Stream a)
+
+-- This must not get a CPR signature that allows for nested cpr,
+-- as it would make the worker call itself before producing the
+-- Stream constructor.
+
+forever :: a -> Stream a
+forever x = Stream x (forever x)
+
+main :: IO ()
+main = forever () `seq` return ()
diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T
index 0c43aac..e8e51de 100644
--- a/testsuite/tests/stranal/should_run/all.T
+++ b/testsuite/tests/stranal/should_run/all.T
@@ -7,3 +7,4 @@ test('strun003', normal, compile_and_run, [''])
 test('strun004', normal, compile_and_run, [''])
 test('T2756b', normal, compile_and_run, [''])
 test('T7649', normal, compile_and_run, [''])
+test('Stream', extra_run_opts('+RTS -M1M -RTS'), compile_and_run, [''])
diff --git a/testsuite/tests/stranal/sigs/StreamSig.hs b/testsuite/tests/stranal/sigs/StreamSig.hs
new file mode 100644
index 0000000..78269d8
--- /dev/null
+++ b/testsuite/tests/stranal/sigs/StreamSig.hs
@@ -0,0 +1,11 @@
+module StreamSig where
+-- Adapted from symalg/RealM.hs's treeFrom
+
+data Stream a = Stream a (Stream a)
+
+-- This must not get a CPR signature that allows for nested cpr,
+-- as it would make the worker call itself before producing the
+-- Stream constructor.
+
+forever :: a -> Stream a
+forever x = Stream x (forever x)
diff --git a/testsuite/tests/stranal/sigs/InfiniteCPRDepth0.stderr b/testsuite/tests/stranal/sigs/StreamSig.stderr
similarity index 63%
copy from testsuite/tests/stranal/sigs/InfiniteCPRDepth0.stderr
copy to testsuite/tests/stranal/sigs/StreamSig.stderr
index 63ca4b6..9d3bf3a 100644
--- a/testsuite/tests/stranal/sigs/InfiniteCPRDepth0.stderr
+++ b/testsuite/tests/stranal/sigs/StreamSig.stderr
@@ -1,5 +1,5 @@
 
 ==================== Strictness signatures ====================
-InfiniteCPR.f: <L,U>
+StreamSig.forever: <L,U>tm(,m(,m(,)))
 
 
diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T
index 7cc7618..3cccc2b 100644
--- a/testsuite/tests/stranal/sigs/all.T
+++ b/testsuite/tests/stranal/sigs/all.T
@@ -20,3 +20,4 @@ test('InfiniteCPR', normal, compile, [''])
 test('InfiniteCPRDepth0', normal, compile, [''])
 test('InfiniteCPRDepth1', normal, compile, [''])
 test('AnonLambda', normal, compile, [''])
+test('StreamSig', normal, compile, [''])