🚀 Functions

This commit is contained in:
2024-09-06 14:10:00 +02:00
parent 1627f4c6aa
commit b4f8b71ade
4 changed files with 47 additions and 27 deletions

View File

@ -19,7 +19,8 @@ data Exp
| If Exp Exp Exp | If Exp Exp Exp
| Var VName | Var VName
| Let VName Exp Exp | Let VName Exp Exp
-- TODO: add cases | Lambda VName Exp
| Apply Exp Exp
deriving (Eq, Show) deriving (Eq, Show)
printExp :: Exp -> String printExp :: Exp -> String

View File

@ -1,8 +1,8 @@
module APL.AST_Tests (tests) where module APL.AST_Tests (tests) where
import APL.AST (Exp (..)) -- import APL.AST (Exp (..))
import Test.Tasty (TestTree, testGroup) import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase, (@?=)) -- import Test.Tasty.HUnit (testCase, (@?=))
tests :: TestTree tests :: TestTree
tests = tests =

View File

@ -11,6 +11,7 @@ import APL.AST (Exp (..), VName)
data Val data Val
= ValInt Integer = ValInt Integer
| ValBool Bool | ValBool Bool
| ValFun Env VName Exp
deriving (Eq, Show) deriving (Eq, Show)
type Env = [(VName, Val)] type Env = [(VName, Val)]
@ -78,5 +79,13 @@ eval env (Let var e1 e2) =
case eval env e1 of case eval env e1 of
Left err -> Left err Left err -> Left err
Right v -> eval (envExtend var v env) e2 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. -- TODO: Add cases after extending Exp.

View File

@ -7,28 +7,28 @@ import Test.Tasty.HUnit (testCase, (@?=))
-- -- Consider this example when you have added the necessary constructors. -- -- Consider this example when you have added the necessary constructors.
-- -- The Y combinator in a form suitable for strict evaluation. -- -- The Y combinator in a form suitable for strict evaluation.
-- yComb :: Exp yComb :: Exp
-- yComb = yComb =
-- Lambda "f" $ Lambda "f" $
-- Apply Apply
-- (Lambda "g" (Apply (Var "g") (Var "g"))) (Lambda "g" (Apply (Var "g") (Var "g")))
-- ( Lambda ( Lambda
-- "g" "g"
-- ( Apply ( Apply
-- (Var "f") (Var "f")
-- (Lambda "a" (Apply (Apply (Var "g") (Var "g")) (Var "a"))) (Lambda "a" (Apply (Apply (Var "g") (Var "g")) (Var "a")))
-- ) )
-- ) )
-- fact :: Exp fact :: Exp
-- fact = fact =
-- Apply yComb $ Apply yComb $
-- Lambda "rec" $ Lambda "rec" $
-- Lambda "n" $ Lambda "n" $
-- If If
-- (Eql (Var "n") (CstInt 0)) (Eql (Var "n") (CstInt 0))
-- (CstInt 1) (CstInt 1)
-- (Mul (Var "n") (Apply (Var "rec") (Sub (Var "n") (CstInt 1)))) (Mul (Var "n") (Apply (Var "rec") (Sub (Var "n") (CstInt 1))))
tests :: TestTree tests :: TestTree
tests = tests =
@ -90,7 +90,17 @@ tests =
(Add (CstInt 2) (CstInt 3)) (Add (CstInt 2) (CstInt 3))
(Let "x" (CstBool True) (Var "x")) (Let "x" (CstBool True) (Var "x"))
) )
@?= Right (ValBool True) @?= Right (ValBool True),
-- testCase "Lambda" $
-- TODO - add more 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)
] ]