From baf70f9d31ac14c4a5f259ba048a46921d4687e5 Mon Sep 17 00:00:00 2001
From: Nikolaj Gade <nikolaj@ingemanngade.net>
Date: Thu, 19 Sep 2024 15:54:56 +0200
Subject: [PATCH] :memo: printing

---
 a2/a2-handout/src/APL/AST.hs        |  2 +-
 a2/a2-handout/src/APL/Eval.hs       | 18 ++++++++++--
 a2/a2-handout/src/APL/Eval_Tests.hs | 45 +++++++++++++++++++----------
 3 files changed, 46 insertions(+), 19 deletions(-)

diff --git a/a2/a2-handout/src/APL/AST.hs b/a2/a2-handout/src/APL/AST.hs
index d886cc9..1e8eff3 100644
--- a/a2/a2-handout/src/APL/AST.hs
+++ b/a2/a2-handout/src/APL/AST.hs
@@ -21,5 +21,5 @@ data Exp
   | Lambda VName Exp
   | Apply Exp Exp
   | TryCatch Exp Exp
-  --  | Print String Exp
+  | Print String Exp
   deriving (Eq, Show)
diff --git a/a2/a2-handout/src/APL/Eval.hs b/a2/a2-handout/src/APL/Eval.hs
index c3ecc23..ab72bd8 100644
--- a/a2/a2-handout/src/APL/Eval.hs
+++ b/a2/a2-handout/src/APL/Eval.hs
@@ -65,12 +65,12 @@ catch (EvalM m1) (EvalM m2) = EvalM $ \env state ->
     (state', Left _) -> m2 env state'
     (state', Right x) -> (state', Right x)
 
-evalPrint :: String -> EvalM ()
-evalPrint a = undefined
-
 runEval :: EvalM a -> (State, Either Error a)
 runEval (EvalM m) = m envEmpty stateEmpty
 
+evalPrint :: String -> EvalM ()
+evalPrint a = EvalM $ \_env state -> (state ++ [a], Right ())
+
 evalIntBinOp :: (Integer -> Integer -> EvalM Integer) -> Exp -> Exp -> EvalM Val
 evalIntBinOp f e1 e2 = do
   v1 <- eval e1
@@ -135,3 +135,15 @@ eval (Apply e1 e2) = do
       failure "Cannot apply non-function"
 eval (TryCatch e1 e2) =
   eval e1 `catch` eval e2
+eval (Print s e1) = do
+  v1 <- eval e1
+  case v1 of
+    (ValInt i) -> do
+      evalPrint (s++": "++(show i))
+      pure $ v1
+    (ValBool b) -> do
+      evalPrint (s++": "++(show b))
+      pure $ v1
+    (ValFun _ _ _) -> do
+      evalPrint (s++": #<fun>")
+      pure $ v1
diff --git a/a2/a2-handout/src/APL/Eval_Tests.hs b/a2/a2-handout/src/APL/Eval_Tests.hs
index e3f68a1..c1f35b9 100644
--- a/a2/a2-handout/src/APL/Eval_Tests.hs
+++ b/a2/a2-handout/src/APL/Eval_Tests.hs
@@ -14,51 +14,51 @@ evalTests =
     "EValuation"
     [ testCase "Add" $
         eval' (Add (CstInt 2) (CstInt 5))
-          @?= Right (ValInt 7),
+          @?= ([], Right (ValInt 7)),
       --
       testCase "Add (wrong type)" $
         eval' (Add (CstInt 2) (CstBool True))
-          @?= Left "Non-integer operand",
+          @?= ([], Left "Non-integer operand"),
       --
       testCase "Sub" $
         eval' (Sub (CstInt 2) (CstInt 5))
-          @?= Right (ValInt (-3)),
+          @?= ([], Right (ValInt (-3))),
       --
       testCase "Div" $
         eval' (Div (CstInt 7) (CstInt 3))
-          @?= Right (ValInt 2),
+          @?= ([], Right (ValInt 2)),
       --
       testCase "Div0" $
         eval' (Div (CstInt 7) (CstInt 0))
-          @?= Left "Division by zero",
+          @?= ([], Left "Division by zero"),
       --
       testCase "Pow" $
         eval' (Pow (CstInt 2) (CstInt 3))
-          @?= Right (ValInt 8),
+          @?= ([], Right (ValInt 8)),
       --
       testCase "Pow0" $
         eval' (Pow (CstInt 2) (CstInt 0))
-          @?= Right (ValInt 1),
+          @?= ([], Right (ValInt 1)),
       --
       testCase "Pow negative" $
         eval' (Pow (CstInt 2) (CstInt (-1)))
-          @?= Left "Negative exponent",
+          @?= ([], Left "Negative exponent"),
       --
       testCase "Eql (false)" $
         eval' (Eql (CstInt 2) (CstInt 3))
-          @?= Right (ValBool False),
+          @?= ([], Right (ValBool False)),
       --
       testCase "Eql (true)" $
         eval' (Eql (CstInt 2) (CstInt 2))
-          @?= Right (ValBool True),
+          @?= ([], Right (ValBool True)),
       --
       testCase "If" $
         eval' (If (CstBool True) (CstInt 2) (Div (CstInt 7) (CstInt 0)))
-          @?= Right (ValInt 2),
+          @?= ([], Right (ValInt 2)),
       --
       testCase "Let" $
         eval' (Let "x" (Add (CstInt 2) (CstInt 3)) (Var "x"))
-          @?= Right (ValInt 5),
+          @?= ([], Right (ValInt 5)),
       --
       testCase "Let (shadowing)" $
         eval'
@@ -67,17 +67,32 @@ evalTests =
               (Add (CstInt 2) (CstInt 3))
               (Let "x" (CstBool True) (Var "x"))
           )
-          @?= Right (ValBool True),
+          @?= ([], Right (ValBool True)),
       --
       testCase "Lambda/Apply" $
         eval'
           (Apply (Lambda "x" (Mul (Var "x") (Var "x"))) (CstInt 4))
-          @?= Right (ValInt 16),
+          @?= ([], Right (ValInt 16)),
       --
       testCase "TryCatch" $
         eval'
           (TryCatch (Div (CstInt 7) (CstInt 0)) (CstBool True))
-          @?= Right (ValBool True)
+          @?= ([], Right (ValBool True)),
+      --
+      testCase "PrintInt" $
+        eval'
+          (Print "Test" (CstInt 3))
+          @?= (["Test: 3"], Right (ValInt 3)),
+      --
+      testCase "PrintBool" $
+        eval'
+          (Print "Test" (CstBool True))
+          @?= (["Test: True"], Right (ValBool True)),
+      --
+      testCase "PrintFun" $
+        eval'
+          (Print "Test" (Lambda "x" (Mul (Var "x") (Var "x"))))
+          @?= (["Test: #<fun>"], Right (ValFun [] "x" (Mul (Var "x") (Var "x"))))
     ]
 
 tests :: TestTree