diff --git a/a1/a1-handout.tar.gz b/a1/a1-handout.tar.gz new file mode 100644 index 0000000..4097c17 Binary files /dev/null and b/a1/a1-handout.tar.gz differ diff --git a/a1/a1-handout/.gitignore b/a1/a1-handout/.gitignore new file mode 100644 index 0000000..48a004c --- /dev/null +++ b/a1/a1-handout/.gitignore @@ -0,0 +1 @@ +dist-newstyle diff --git a/a1/a1-handout/a1.cabal b/a1/a1-handout/a1.cabal new file mode 100644 index 0000000..90f18a7 --- /dev/null +++ b/a1/a1-handout/a1.cabal @@ -0,0 +1,31 @@ +cabal-version: 3.0 +name: a1 +version: 1.0.0.0 +build-type: Simple + +common common + default-language: Haskell2010 + ghc-options: -Wall + +library + import: common + hs-source-dirs: src + build-depends: + base + , tasty + , tasty-hunit + exposed-modules: + APL.AST + APL.AST_Tests + APL.Eval + APL.Eval_Tests + +test-suite a1-test + import: common + type: exitcode-stdio-1.0 + main-is: runtests.hs + build-depends: + base + , tasty + , a1 + diff --git a/a1/a1-handout/runtests.hs b/a1/a1-handout/runtests.hs new file mode 100644 index 0000000..59d03f8 --- /dev/null +++ b/a1/a1-handout/runtests.hs @@ -0,0 +1,12 @@ +import qualified APL.AST_Tests +import qualified APL.Eval_Tests +import Test.Tasty (defaultMain, testGroup) + +main :: IO () +main = + defaultMain $ + testGroup + "APL" + [ APL.AST_Tests.tests, + APL.Eval_Tests.tests + ] diff --git a/a1/a1-handout/src/APL/AST.hs b/a1/a1-handout/src/APL/AST.hs new file mode 100644 index 0000000..d63d498 --- /dev/null +++ b/a1/a1-handout/src/APL/AST.hs @@ -0,0 +1,26 @@ +module APL.AST + ( VName, + Exp (..), + printExp, + ) +where + +type VName = String + +data Exp + = CstInt Integer + | CstBool Bool + | Add Exp Exp + | Sub Exp Exp + | Mul Exp Exp + | Div Exp Exp + | Pow Exp Exp + | Eql Exp Exp + | If Exp Exp Exp + | Var VName + | Let VName Exp Exp + -- TODO: add cases + deriving (Eq, Show) + +printExp :: Exp -> String +printExp = undefined -- TODO diff --git a/a1/a1-handout/src/APL/AST_Tests.hs b/a1/a1-handout/src/APL/AST_Tests.hs new file mode 100644 index 0000000..92f6c01 --- /dev/null +++ b/a1/a1-handout/src/APL/AST_Tests.hs @@ -0,0 +1,11 @@ +module APL.AST_Tests (tests) where + +import APL.AST (Exp (..)) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (testCase, (@?=)) + +tests :: TestTree +tests = + testGroup + "Prettyprinting" + [] diff --git a/a1/a1-handout/src/APL/Eval.hs b/a1/a1-handout/src/APL/Eval.hs new file mode 100644 index 0000000..5ec7efd --- /dev/null +++ b/a1/a1-handout/src/APL/Eval.hs @@ -0,0 +1,82 @@ +module APL.Eval + ( Val (..), + Env, + envEmpty, + eval, + ) +where + +import APL.AST (Exp (..), VName) + +data Val + = ValInt Integer + | ValBool Bool + deriving (Eq, Show) + +type Env = [(VName, Val)] + +envEmpty :: Env +envEmpty = [] + +envExtend :: VName -> Val -> Env -> Env +envExtend v val env = (v, val) : env + +envLookup :: VName -> Env -> Maybe Val +envLookup v env = lookup v env + +type Error = String + +evalIntBinOp :: (Integer -> Integer -> Either Error Integer) -> Env -> Exp -> Exp -> Either Error Val +evalIntBinOp f env e1 e2 = + case (eval env e1, eval env e2) of + (Left err, _) -> Left err + (_, Left err) -> Left err + (Right (ValInt x), Right (ValInt y)) -> case f x y of + Left err -> Left err + Right z -> Right $ ValInt z + (Right _, Right _) -> Left "Non-integer operand" + +evalIntBinOp' :: (Integer -> Integer -> Integer) -> Env -> Exp -> Exp -> Either Error Val +evalIntBinOp' f env e1 e2 = + evalIntBinOp f' env e1 e2 + where + f' x y = Right $ f x y + +eval :: Env -> Exp -> Either Error Val +eval _env (CstInt x) = Right $ ValInt x +eval _env (CstBool b) = Right $ ValBool b +eval env (Var v) = case envLookup v env of + Just x -> Right x + Nothing -> Left $ "Unknown variable: " ++ v +eval env (Add e1 e2) = evalIntBinOp' (+) env e1 e2 +eval env (Sub e1 e2) = evalIntBinOp' (-) env e1 e2 +eval env (Mul e1 e2) = evalIntBinOp' (*) env e1 e2 +eval env (Div e1 e2) = evalIntBinOp checkedDiv env e1 e2 + where + checkedDiv _ 0 = Left "Division by zero" + checkedDiv x y = Right $ x `div` y +eval env (Pow e1 e2) = evalIntBinOp checkedPow env e1 e2 + where + checkedPow x y = + if y < 0 + then Left "Negative exponent" + else Right $ x ^ y +eval env (Eql e1 e2) = + case (eval env e1, eval env e2) of + (Left err, _) -> Left err + (_, Left err) -> Left err + (Right (ValInt x), Right (ValInt y)) -> Right $ ValBool $ x == y + (Right (ValBool x), Right (ValBool y)) -> Right $ ValBool $ x == y + (Right _, Right _) -> Left "Invalid operands to equality" +eval env (If cond e1 e2) = + case eval env cond of + Left err -> Left err + Right (ValBool True) -> eval env e1 + Right (ValBool False) -> eval env e2 + Right _ -> Left "Non-boolean conditional." +eval env (Let var e1 e2) = + case eval env e1 of + Left err -> Left err + Right v -> eval (envExtend var v env) e2 + +-- TODO: Add cases after extending Exp. diff --git a/a1/a1-handout/src/APL/Eval_Tests.hs b/a1/a1-handout/src/APL/Eval_Tests.hs new file mode 100644 index 0000000..98e67ec --- /dev/null +++ b/a1/a1-handout/src/APL/Eval_Tests.hs @@ -0,0 +1,96 @@ +module APL.Eval_Tests (tests) where + +import APL.AST (Exp (..)) +import APL.Eval (Val (..), envEmpty, eval) +import Test.Tasty (TestTree, testGroup) +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"))) +-- ) +-- ) + +-- 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 = + testGroup + "Evaluation" + [ testCase "Add" $ + eval envEmpty (Add (CstInt 2) (CstInt 5)) + @?= Right (ValInt 7), + -- + testCase "Add (wrong type)" $ + eval envEmpty (Add (CstInt 2) (CstBool True)) + @?= Left "Non-integer operand", + -- + testCase "Sub" $ + eval envEmpty (Sub (CstInt 2) (CstInt 5)) + @?= Right (ValInt (-3)), + -- + testCase "Div" $ + eval envEmpty (Div (CstInt 7) (CstInt 3)) + @?= Right (ValInt 2), + -- + testCase "Div0" $ + eval envEmpty (Div (CstInt 7) (CstInt 0)) + @?= Left "Division by zero", + -- + testCase "Pow" $ + eval envEmpty (Pow (CstInt 2) (CstInt 3)) + @?= Right (ValInt 8), + -- + testCase "Pow0" $ + eval envEmpty (Pow (CstInt 2) (CstInt 0)) + @?= Right (ValInt 1), + -- + testCase "Pow negative" $ + eval envEmpty (Pow (CstInt 2) (CstInt (-1))) + @?= Left "Negative exponent", + -- + testCase "Eql (false)" $ + eval envEmpty (Eql (CstInt 2) (CstInt 3)) + @?= Right (ValBool False), + -- + testCase "Eql (true)" $ + eval envEmpty (Eql (CstInt 2) (CstInt 2)) + @?= Right (ValBool True), + -- + testCase "If" $ + eval envEmpty (If (CstBool True) (CstInt 2) (Div (CstInt 7) (CstInt 0))) + @?= Right (ValInt 2), + -- + testCase "Let" $ + eval envEmpty (Let "x" (Add (CstInt 2) (CstInt 3)) (Var "x")) + @?= Right (ValInt 5), + -- + testCase "Let (shadowing)" $ + eval + envEmpty + ( Let + "x" + (Add (CstInt 2) (CstInt 3)) + (Let "x" (CstBool True) (Var "x")) + ) + @?= Right (ValBool True) + -- + -- TODO - add more + ] diff --git a/a1/a1.pdf b/a1/a1.pdf new file mode 100644 index 0000000..bfbf554 Binary files /dev/null and b/a1/a1.pdf differ