diff options
Diffstat (limited to 'testsuite/tests/simplCore/should_compile')
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/T19581.hs | 38 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/T19581.stderr | 77 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/all.T | 3 |
3 files changed, 118 insertions, 0 deletions
diff --git a/testsuite/tests/simplCore/should_compile/T19581.hs b/testsuite/tests/simplCore/should_compile/T19581.hs new file mode 100644 index 0000000000..448ce349d6 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T19581.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE MagicHash #-} + +module Foo where + +import GHC.Exts + +g :: Int# -> Int# +{-# NOINLINE g #-} +g x = x +# 1# + +-- Setting up this test case is quite delicate. +-- +-- With the code below, simplification terminates too early. +-- +-- Removing either of the (g (x +# 1#)) cases makes successively +-- merge 2 layers at a time, so it takes multiple iterations to +-- get a fixpoint. + +f :: Int# -> Int# +f x = case g x of { + 1# -> 2# ; _ -> + + case g (x +# 1#) of { z -> + + case g x of { + 2# -> z ; _ -> + + case g (x +# 2#) of { z1 -> + + case g x of { + 3# -> 4#; _ -> case g x of { + 4# -> z; _ -> case g x of { + 5# -> 6#; _ -> case g x of { + 6# -> z; _ -> case g x of { + 7# -> 8#; _ -> case g x of { + 8# -> 9#; _ -> case g x of { + 9# -> 10#; _ -> 6# + }}}}}}}}}}} diff --git a/testsuite/tests/simplCore/should_compile/T19581.stderr b/testsuite/tests/simplCore/should_compile/T19581.stderr new file mode 100644 index 0000000000..683e67d3c4 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T19581.stderr @@ -0,0 +1,77 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 60, types: 16, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0} +g [InlPrag=NOINLINE] :: Int# -> Int# +[GblId, Arity=1, Str=<L>, Unf=OtherCon []] +g = \ (x :: Int#) -> +# x 1# + +-- RHS size: {terms: 40, types: 6, coercions: 0, joins: 0/0} +f :: Int# -> Int# +[GblId, + Arity=1, + Str=<L>, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 192 0}] +f = \ (x :: Int#) -> + case g x of ds { + __DEFAULT -> + case g (+# x 1#) of z { __DEFAULT -> + case ds of ds1 { + __DEFAULT -> + case g (+# x 2#) of { __DEFAULT -> + case ds1 of { + __DEFAULT -> 6#; + 3# -> 4#; + 4# -> z; + 6# -> z; + 7# -> 8#; + 8# -> 9#; + 9# -> 10# + } + }; + 2# -> z + } + }; + 1# -> 2# + } + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +Foo.$trModule4 :: Addr# +[GblId, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +Foo.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +Foo.$trModule3 :: GHC.Types.TrName +[GblId, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +Foo.$trModule3 = GHC.Types.TrNameS Foo.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +Foo.$trModule2 :: Addr# +[GblId, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +Foo.$trModule2 = "Foo"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +Foo.$trModule1 :: GHC.Types.TrName +[GblId, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +Foo.$trModule1 = GHC.Types.TrNameS Foo.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +Foo.$trModule :: GHC.Types.Module +[GblId, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +Foo.$trModule = GHC.Types.Module Foo.$trModule3 Foo.$trModule1 + + + diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index a2783f33e1..23058c2cd8 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -347,3 +347,6 @@ test('T18995', [ grep_errmsg(r'print') ], compile, ['-O -ddump-simpl -dsuppress- test('T19168', normal, compile, ['']) test('T19246', only_ways(['optasm']), multimod_compile, ['T19246', '-v0 -ddump-rules']) test('T19360', only_ways(['optasm']), compile, ['']) + +# If the test goes wrong we'll get more case expressions in the output +test('T19581', [ grep_errmsg(r'case') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) |