🚀 Functions

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

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 =

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.

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)
     ]