[commit: ghc] master: CSE should deal with letrec (ec49b42)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/ec49b42bbff4ee81c825a0facee26b13f1f297a7/ghc

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

commit ec49b42bbff4ee81c825a0facee26b13f1f297a7
Author: roland <rsx at bluewin.ch>
Date:   Sun Aug 12 10:24:29 2018 +0200

    CSE should deal with letrec
    
    Summary: Add testcase for  #9441
    
    Test Plan: make test TESTS="T9441a T9441b T9441c"
    
    Reviewers: dfeuer, simonpj, thomie, austin, bgamari
    
    Reviewed By: dfeuer
    
    Subscribers: rwbarton, carter
    
    GHC Trac Issues: #9441
    
    Differential Revision: https://phabricator.haskell.org/D5038


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

ec49b42bbff4ee81c825a0facee26b13f1f297a7
 testsuite/tests/simplCore/should_compile/Makefile      | 13 +++++++++++++
 testsuite/tests/simplCore/should_compile/T9441a.hs     |  9 +++++++++
 testsuite/tests/simplCore/should_compile/T9441a.stdout |  1 +
 testsuite/tests/simplCore/should_compile/T9441b.hs     | 15 +++++++++++++++
 testsuite/tests/simplCore/should_compile/T9441b.stdout |  1 +
 testsuite/tests/simplCore/should_compile/T9441c.hs     | 13 +++++++++++++
 testsuite/tests/simplCore/should_compile/T9441c.stdout |  1 +
 testsuite/tests/simplCore/should_compile/all.T         |  3 +++
 8 files changed, 56 insertions(+)

diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile
index 5f077b2..0fb5dc2 100644
--- a/testsuite/tests/simplCore/should_compile/Makefile
+++ b/testsuite/tests/simplCore/should_compile/Makefile
@@ -27,6 +27,19 @@ T8848:
 	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-rule-firings T8848.hs | grep 'SPEC map2'
         # Should fire twice
 
+T9441a:
+	$(RM) -f T9941a.o T9941a.hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-all T9441a.hs | grep 'f1 = f2'
+	    # Grep output should show 'f1 = f2'
+T9441b:
+	$(RM) -f T9941b.o T9941b.hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-all T9441b.hs | grep 'Rec {'
+	    # Grep output should show only one recursive Bind 'Rec {'
+T9441c:
+	$(RM) -f T9941c.o T9941c.hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-all T9441c.hs | grep 'Rec {'
+	    # Grep output should show only one recursive Bind 'Rec {'
+
 T9509:
 	$(RM) -f T9509*.o T9509*.hi
 	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c T9509a.hs
diff --git a/testsuite/tests/simplCore/should_compile/T9441a.hs b/testsuite/tests/simplCore/should_compile/T9441a.hs
new file mode 100644
index 0000000..9eef17d
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T9441a.hs
@@ -0,0 +1,9 @@
+module T9441a where
+
+f1 :: Integer -> Integer
+f1 1 = 1
+f1 n = n * f1 (n - 1)
+
+f2 :: Integer -> Integer
+f2 1 = 1
+f2 m = m * f2 (m - 1)
diff --git a/testsuite/tests/simplCore/should_compile/T9441a.stdout b/testsuite/tests/simplCore/should_compile/T9441a.stdout
new file mode 100644
index 0000000..205ae52
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T9441a.stdout
@@ -0,0 +1 @@
+f1 = f2
diff --git a/testsuite/tests/simplCore/should_compile/T9441b.hs b/testsuite/tests/simplCore/should_compile/T9441b.hs
new file mode 100644
index 0000000..464c96e
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T9441b.hs
@@ -0,0 +1,15 @@
+module T9441b where
+
+f1 :: Integer -> Integer
+f1 n
+    | n <= 1 = 1
+    | otherwise = go n 1
+  where
+    go 0 r = r
+    go m r = go (m - 1) (r * m)
+
+f2 :: Integer -> Integer
+f2 n = go n 1
+  where
+    go 0 s = s
+    go p s = go (p - 1) (s * p)
diff --git a/testsuite/tests/simplCore/should_compile/T9441b.stdout b/testsuite/tests/simplCore/should_compile/T9441b.stdout
new file mode 100644
index 0000000..10be0cd
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T9441b.stdout
@@ -0,0 +1 @@
+Rec {
diff --git a/testsuite/tests/simplCore/should_compile/T9441c.hs b/testsuite/tests/simplCore/should_compile/T9441c.hs
new file mode 100644
index 0000000..872e97e
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T9441c.hs
@@ -0,0 +1,13 @@
+module T9441 where
+-- Core output should show only one recursive Bind Rec { .. }
+import GHC.Exts (build)
+
+{-# INLINE reverse' #-}
+reverse' :: [a] -> [a]
+reverse' xs = build $ \c n -> foldl (\a x -> x `c` a) n xs
+
+appRev :: [a] -> [a] -> [a]
+appRev xs ys = xs ++ reverse' ys
+
+revAppRev :: [a] -> [a] -> [a]
+revAppRev xs ys = reverse' xs ++ reverse' ys
diff --git a/testsuite/tests/simplCore/should_compile/T9441c.stdout b/testsuite/tests/simplCore/should_compile/T9441c.stdout
new file mode 100644
index 0000000..10be0cd
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T9441c.stdout
@@ -0,0 +1 @@
+Rec {
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 95a9d99..07b5f0a 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -196,6 +196,9 @@ test('T8848a', only_ways(['optasm']), compile, ['-ddump-rules'])
 test('T8331', only_ways(['optasm']), compile, ['-ddump-rules'])
 test('T6056', only_ways(['optasm']), multimod_compile, ['T6056', '-v0 -ddump-rule-firings'])
 test('T9400', only_ways(['optasm']), compile, ['-O0 -ddump-simpl -dsuppress-uniques'])
+test('T9441a', normal, run_command, ['$MAKE -s --no-print-directory T9441a'])
+test('T9441b', normal, run_command, ['$MAKE -s --no-print-directory T9441b'])
+test('T9441c', normal, run_command, ['$MAKE -s --no-print-directory T9441c'])
 test('T9583', only_ways(['optasm']), compile, [''])
 test('T9565', only_ways(['optasm']), compile, [''])
 test('T5821', only_ways(['optasm']), compile, [''])