diff --git a/a1/src/APL/AST.hs b/a1/src/APL/AST.hs index d63d498..102380f 100644 --- a/a1/src/APL/AST.hs +++ b/a1/src/APL/AST.hs @@ -19,7 +19,8 @@ data Exp | If Exp Exp Exp | Var VName | Let VName Exp Exp - -- TODO: add cases + | Lambda VName Exp + | Apply Exp Exp deriving (Eq, Show) printExp :: Exp -> String diff --git a/a1/src/APL/AST_Tests.hs b/a1/src/APL/AST_Tests.hs index 92f6c01..826229e 100644 --- a/a1/src/APL/AST_Tests.hs +++ b/a1/src/APL/AST_Tests.hs @@ -1,8 +1,8 @@ module APL.AST_Tests (tests) where -import APL.AST (Exp (..)) +-- import APL.AST (Exp (..)) import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (testCase, (@?=)) +-- import Test.Tasty.HUnit (testCase, (@?=)) tests :: TestTree tests = diff --git a/a1/src/APL/Eval.hs b/a1/src/APL/Eval.hs index 5ec7efd..dd8cb6c 100644 --- a/a1/src/APL/Eval.hs +++ b/a1/src/APL/Eval.hs @@ -11,6 +11,7 @@ import APL.AST (Exp (..), VName) data Val = ValInt Integer | ValBool Bool + | ValFun Env VName Exp deriving (Eq, Show) type Env = [(VName, Val)] @@ -78,5 +79,13 @@ eval env (Let var e1 e2) = case eval env e1 of Left err -> Left err Right v -> eval (envExtend var v env) e2 +eval env (Lambda var e) = Right $ ValFun env var e +eval env (Apply e1 e2) = + case (eval env e1, eval env e2) of + (Left err, _) -> Left err + (_, Left err) -> Left err + (Right (ValFun env2 var e3), Right x) -> eval (envExtend var x env2) e3 + (_, _) -> Left "Applying non-function" + -- TODO: Add cases after extending Exp. diff --git a/a1/src/APL/Eval_Tests.hs b/a1/src/APL/Eval_Tests.hs index 98e67ec..2de7f6b 100644 --- a/a1/src/APL/Eval_Tests.hs +++ b/a1/src/APL/Eval_Tests.hs @@ -7,28 +7,28 @@ import Test.Tasty.HUnit (testCase, (@?=)) -- -- Consider this example when you have added the necessary constructors. -- -- The Y combinator in a form suitable for strict evaluation. --- yComb :: Exp --- yComb = --- Lambda "f" $ --- Apply --- (Lambda "g" (Apply (Var "g") (Var "g"))) --- ( Lambda --- "g" --- ( Apply --- (Var "f") --- (Lambda "a" (Apply (Apply (Var "g") (Var "g")) (Var "a"))) --- ) --- ) +yComb :: Exp +yComb = + Lambda "f" $ + Apply + (Lambda "g" (Apply (Var "g") (Var "g"))) + ( Lambda + "g" + ( Apply + (Var "f") + (Lambda "a" (Apply (Apply (Var "g") (Var "g")) (Var "a"))) + ) + ) --- fact :: Exp --- fact = --- Apply yComb $ --- Lambda "rec" $ --- Lambda "n" $ --- If --- (Eql (Var "n") (CstInt 0)) --- (CstInt 1) --- (Mul (Var "n") (Apply (Var "rec") (Sub (Var "n") (CstInt 1)))) +fact :: Exp +fact = + Apply yComb $ + Lambda "rec" $ + Lambda "n" $ + If + (Eql (Var "n") (CstInt 0)) + (CstInt 1) + (Mul (Var "n") (Apply (Var "rec") (Sub (Var "n") (CstInt 1)))) tests :: TestTree tests = @@ -90,7 +90,17 @@ tests = (Add (CstInt 2) (CstInt 3)) (Let "x" (CstBool True) (Var "x")) ) - @?= Right (ValBool True) - -- - -- TODO - add more + @?= Right (ValBool True), + testCase "Lambda" $ + eval + envEmpty + ( + Lambda "y" (Var "y") + ) + @?= Right (ValFun [] "y" (Var "y")), + testCase "Apply" $ + eval [] (Apply (Let "x" (CstInt 2) (Lambda "y" (Add (Var "x") (Var "y")))) (CstInt 3)) + @?= Right (ValInt 5), + testCase "Apply (fact)" $ + eval envEmpty (Apply fact (CstInt 5)) @?= Right (ValInt 120) ]