Commit ec49b42b authored by Roland Senn's avatar Roland Senn Committed by Krzysztof Gogolewski

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
parent 97596a44
......@@ -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
......@@ -192,7 +205,7 @@ T5996:
'$(TEST_HC)' $(TEST_HC_OPTS) -O -c T5996.hs -ddump-simpl -dsuppress-uniques -dsuppress-all | grep y2
T10083:
$(RM) -f T10083.o T10083.hi T10083.hi-boot T10083a.o T10083a.hi
$(RM) -f T10083.o T10083.hi T10083.hi-boot T10083a.o T10083a.hi
'$(TEST_HC)' $(TEST_HC_OPTS) -c -O T10083.hs-boot
'$(TEST_HC)' $(TEST_HC_OPTS) -c -O T10083a.hs
'$(TEST_HC)' $(TEST_HC_OPTS) -c -O T10083.hs
......
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)
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)
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
......@@ -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, [''])
......
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