74 lines
2.9 KiB
Haskell
74 lines
2.9 KiB
Haskell
import LambdaCalculus
|
|
|
|
import Test.Tasty
|
|
import Test.Tasty.HUnit
|
|
|
|
-- These are terms which have complex reduction steps and
|
|
-- are likely to catch bugs in the substitution function, if there are any.
|
|
-- However, they don't have any particular computational *meaning*,
|
|
-- so the names for them are somewhat arbitrary.
|
|
|
|
-- This should evaluate to `y y`.
|
|
dfi :: EvalExpr
|
|
dfi = App d (App f i)
|
|
where
|
|
d = Abs "x" $ App (Var "x") (Var "x")
|
|
f = Abs "f" $ App (Var "f") (App (Var "f") (Var "y"))
|
|
i = Abs "x" $ Var "x"
|
|
|
|
-- This should evalaute to `y`.
|
|
ttttt :: EvalExpr
|
|
ttttt = App (App (App f t) (Abs "x" (Var "x"))) (Var "y")
|
|
where
|
|
t = Abs "f" $ Abs "x" $
|
|
App (Var "f") (App (Var "f") (Var "x"))
|
|
f = Abs "T" $ Abs "f" $ Abs "x" $
|
|
App
|
|
(App
|
|
(App (Var "T")
|
|
(App (Var "T")
|
|
(App (Var "T")
|
|
(App (Var "T")
|
|
(Var "T")))))
|
|
(Var "f"))
|
|
(Var "x")
|
|
|
|
-- | A simple divergent expression.
|
|
omega :: EvalExpr
|
|
omega = App x x
|
|
where x = Abs "x" (App (Var "x") (Var "x"))
|
|
|
|
cc1 :: EvalExpr
|
|
cc1 = App (Var "callcc") (Abs "k" (App omega (App (Var "k") (Var "z"))))
|
|
|
|
cc2 :: EvalExpr
|
|
cc2 = App (Var "y") (App (Var "callcc") (Abs "k" (App (Var "z") (App (Var "k") (Var "x")))))
|
|
|
|
main :: IO ()
|
|
main = defaultMain $
|
|
testGroup "Tests"
|
|
[ testGroup "Evaluator tests"
|
|
[ testCase "capture test 1: DFI" $ eval dfi @?= App (Var "y") (Var "y")
|
|
, testCase "capture test 2: ttttt" $ eval ttttt @?= Var "y"
|
|
, testCase "invoking a continuation replaces the current continuation" $ eval cc1 @?= Var "z"
|
|
, testCase "callcc actually captures the current continuation" $ eval cc2 @?= App (Var "y") (Var "x")
|
|
]
|
|
, testGroup "Parser tests"
|
|
[ testGroup "Unit tests"
|
|
[ testCase "identity" $ parseEval "\\x.x" @?= Right (Abs "x" $ Var "x")
|
|
, testCase "unary application" $ parseEval "(x)" @?= Right (Var "x")
|
|
, testCase "application shorthand" $ parseEval "a b c d" @?= Right (App (App (App (Var "a") (Var "b")) (Var "c")) (Var "d"))
|
|
, testCase "let" $ parseEval "let x = \\y.y in x" @?= Right (App (Abs "x" (Var "x")) (Abs "y" (Var "y")))
|
|
, testCase "multi-let" $ parseEval "let x = y; y = z in x y" @?= Right (App (Abs "x" (App (Abs "y" (App (Var "x") (Var "y"))) (Var "z"))) (Var "y"))
|
|
, testCase "ttttt" $ parseEval "(\\T f x.(T (T (T (T T)))) f x) (\\f x.f (f x)) (\\x.x) y"
|
|
@?= Right ttttt
|
|
, testGroup "Redundant whitespace"
|
|
[ testCase "around variable" $ parseEval " x " @?= Right (Var "x")
|
|
, testCase "around lambda" $ parseEval " \\ x y . x " @?= Right (Abs "x" $ Abs "y" $ Var "x")
|
|
, testCase "around application" $ parseEval " ( x (y ) ) " @?= Right (App (Var "x") (Var "y"))
|
|
, testCase "around let" $ parseEval " let x=(y)in x " @?= Right (App (Abs "x" (Var "x")) (Var "y"))
|
|
]
|
|
]
|
|
]
|
|
]
|