Add Assignment 1 handout

a1/a1-handout/.gitignore

@@ -0,0 +1 @@
+dist-newstyle

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
+

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

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

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"
+    []

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.

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