From 0c815fa3eb480ae5e05370699cead004d81cf65c Mon Sep 17 00:00:00 2001
From: Paweł Dybiec <pawel.to.malpa@gmail.com>
Date: Sun, 19 Jan 2020 22:59:54 +0100
Subject: Add Except monad, and destructors for records and variants

---
 test/TypecheckTest.hs | 44 ++++++++++++++++++++++++++------------------
 1 file changed, 26 insertions(+), 18 deletions(-)

(limited to 'test')

diff --git a/test/TypecheckTest.hs b/test/TypecheckTest.hs
index 299c8c0..4e410ed 100644
--- a/test/TypecheckTest.hs
+++ b/test/TypecheckTest.hs
@@ -2,33 +2,41 @@ module TypecheckTest
   where
 import Typecheck
 import Syntax
+import Control.Monad.Except (runExcept)
 import Test.Hspec
+
+
 typecheckTest :: Spec
 typecheckTest = describe "inferExpr" $ do
   it "can infer variables" $ do
-    inferExpr (Var "a") [("a", TInt)] `shouldBe`  Just TInt
-    inferExpr (Var "a") [("a", TRecord [("b",TInt)])] `shouldBe`  (Just $ TRecord [("b",TInt)])
-    inferExpr (Var "a") [("a", TVariant [("b",TInt)])] `shouldBe` (Just $ TVariant[("b",TInt)])
-    inferExpr (Var "a") [("a", TPtr TInt)] `shouldBe` ( Just $ TPtr TInt )
+    infer (Var "a") [("a", TInt)] `shouldBe`  Just TInt
+    infer (Var "a") [("a", TRecord [("b",TInt)])] `shouldBe`  (Just $ TRecord [("b",TInt)])
+    infer (Var "a") [("a", TVariant [("b",TInt)])] `shouldBe` (Just $ TVariant[("b",TInt)])
+    infer (Var "a") [("a", TPtr TInt)] `shouldBe` ( Just $ TPtr TInt )
   it "shouldn't infer undefined variables" $ do
-    inferExpr (Var "a") [] `shouldBe` Nothing
+    infer (Var "a") [] `shouldBe` Nothing
   it "should be able to infer types of arithmetic expressions" $ do
-    inferExpr (IntLit 5) [] `shouldBe` (Just TInt)
-    inferExpr (Add (IntLit 1) (IntLit 3)) [] `shouldBe` (Just TInt)
-    inferExpr (Mult (IntLit 1) (IntLit 3)) [] `shouldBe` (Just TInt)
-    inferExpr (Neg (IntLit 3)) [] `shouldBe` (Just TInt)
+    infer (IntLit 5) [] `shouldBe` (Just TInt)
+    infer (Add (IntLit 1) (IntLit 3)) [] `shouldBe` (Just TInt)
+    infer (Mult (IntLit 1) (IntLit 3)) [] `shouldBe` (Just TInt)
+    infer (Neg (IntLit 3)) [] `shouldBe` (Just TInt)
   it "shouldn't be able to do arithmetic operations on pointer" $ do
-    inferExpr (Add (IntLit 1) (Var "a")) [("a",(TPtr TInt))] `shouldBe` Nothing
-    inferExpr (Add (Var "a") (IntLit 1)) [("a",(TPtr TInt))] `shouldBe` Nothing
-    inferExpr (Mult (IntLit 1) (Var "a")) [("a",(TPtr TInt))] `shouldBe` Nothing
-    inferExpr (Mult (Var "a") (IntLit 1)) [("a",(TPtr TInt))] `shouldBe` Nothing
-    inferExpr (Neg (Var "a")) [("a",(TPtr TInt))] `shouldBe` Nothing
+    infer (Add (IntLit 1) (Var "a")) [("a",(TPtr TInt))] `shouldBe` Nothing
+    infer (Add (Var "a") (IntLit 1)) [("a",(TPtr TInt))] `shouldBe` Nothing
+    infer (Mult (IntLit 1) (Var "a")) [("a",(TPtr TInt))] `shouldBe` Nothing
+    infer (Mult (Var "a") (IntLit 1)) [("a",(TPtr TInt))] `shouldBe` Nothing
+    infer (Neg (Var "a")) [("a",(TPtr TInt))] `shouldBe` Nothing
   it "should infer compound types" $ do
-    inferExpr (Variant (TVariant [("Cons",TInt),("Cons2",TPtr TInt)]) "Cons" (IntLit 5)) [] `shouldBe` (Just $ TVariant [("Cons",TInt),("Cons2",TPtr TInt)])
-    inferExpr (Record [("aa",Var "a"),("bb",Var "b")]) [("a",TInt), ("b",TPtr TInt)] `shouldBe` (Just $ TRecord [("aa",TInt),("bb",TPtr TInt)])
+    infer (Variant (TVariant [("Cons",TInt),("Cons2",TPtr TInt)]) "Cons" (IntLit 5)) [] `shouldBe` (Just $ TVariant [("Cons",TInt),("Cons2",TPtr TInt)])
+    infer (Record [("aa",Var "a"),("bb",Var "b")]) [("a",TInt), ("b",TPtr TInt)] `shouldBe` (Just $ TRecord [("aa",TInt),("bb",TPtr TInt)])
   it "should unpack Ptr for every dereference" $ do
-    inferExpr (Deref (Var "a")) [("a",TPtr TInt)] `shouldBe` (Just TInt)
-    inferExpr (Deref (Var "a")) [("a",TPtr $ TPtr TInt)] `shouldBe` (Just $ TPtr TInt)
+    infer (Deref (Var "a")) [("a",TPtr TInt)] `shouldBe` (Just TInt)
+    infer (Deref (Var "a")) [("a",TPtr $ TPtr TInt)] `shouldBe` (Just $ TPtr TInt)
+  where
+    infer :: Expr -> Environment -> Maybe Typ
+    infer e env=  eitherToMaybe $ runExcept $ inferExpr e env
+    eitherToMaybe (Right a) = Just a
+    eitherToMaybe (Left _) = Nothing
 
 
 
-- 
cgit 1.4.1