diff options
author | sheaf <sam.derbyshire@gmail.com> | 2022-01-03 10:56:11 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-01-03 16:50:07 -0500 |
commit | 7f10686e61e49c89baf45df92eb24ad3504492f7 (patch) | |
tree | fcb42c3d38ed8a0bed6aae7a68549377afa2b568 /testsuite/tests/simplCore | |
parent | a49f58890b3a8d9759b7147b6dfdaf7287679e3f (diff) | |
download | haskell-7f10686e61e49c89baf45df92eb24ad3504492f7.tar.gz |
Add test for #20894
Diffstat (limited to 'testsuite/tests/simplCore')
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T20894.hs | 23 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/all.T | 2 |
2 files changed, 25 insertions, 0 deletions
diff --git a/testsuite/tests/simplCore/should_compile/T20894.hs b/testsuite/tests/simplCore/should_compile/T20894.hs new file mode 100644 index 0000000000..d8ae7a3b99 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T20894.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE Haskell2010 #-} + +module T20894 where + +import Prelude (Int) + +data LitE = IntLit !Int | StringLit +data Term = LitE LitE | Term :$ Term | S Term | VarE +data Val = LitV LitE + +eval :: Term -> Val +eval (LitE l) = LitV l +eval (S a) = eval a +eval _ = LitV StringLit + +church :: Int -> Term +church 0 = VarE +church _ = S VarE + +evalChurchId :: Int -> Int -> Int +evalChurchId i arg = + case eval (S (S (church i)) :$ LitE (IntLit arg) ) of + LitV (IntLit res) -> res diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index d500b5364a..7285b91c45 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -377,3 +377,5 @@ test('T20200a', normal, compile, ['-O2']) test('T20200b', normal, compile, ['-O2']) test('T20200KG', [extra_files(['T20200KGa.hs', 'T20200KG.hs-boot'])], multimod_compile, ['T20200KG', '-v0 -O2 -fspecialise-aggressively']) test('T20639', normal, compile, ['-O2']) + +test('T20894', normal, compile, ['-dcore-lint -O1 -ddebug-output']) |