From: pimjager <pim@pimjager.nl>
Date: Fri, 22 Apr 2016 11:19:56 +0000 (+0200)
Subject: Added op2type function
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=43f59bf00c11cfbeee906b16063abfca6f4c09cc;p=cc1516.git

Added op2type function
---

diff --git a/AST.dcl b/AST.dcl
index 45eab9e..e9c6944 100644
--- a/AST.dcl
+++ b/AST.dcl
@@ -1,7 +1,7 @@
 definition module AST
 
 from Data.Maybe import :: Maybe
-from StdOverloaded import class toString, class ==
+from StdOverloaded import class toString, class ==, class <
 
 :: Pos = {line :: Int, col :: Int}
 :: AST = AST [FunDecl]
@@ -41,3 +41,7 @@ from StdOverloaded import class toString, class ==
 instance toString Pos
 instance toString Type
 instance toString AST
+instance == Op1
+instance == Op2
+instance < Op1
+instance < Op2
diff --git a/AST.icl b/AST.icl
index 90d1e53..26686b2 100644
--- a/AST.icl
+++ b/AST.icl
@@ -84,6 +84,10 @@ instance toString Op2 where
 		BiLesserEq = "<="; BiGreaterEq = ">="; BiUnEqual = "!=";
 		BiAnd = "&&"; BiOr = "||"; BiCons = ":"
 
+instance toString Op1 where
+    toString UnNegation = "!"
+    toString UnMinus = "-"
+
 instance print Expr where
 	print (VarExpr _ vd) = print vd
 	print (Op2Expr _ e1 o e2) = ["(":print e1] ++ 
@@ -110,3 +114,12 @@ printFunCall s args = [s, "(":printersperse "," args] ++ [")"]
 
 derive gEq Op2
 instance == Op2 where (==) o1 o2 = gEq{|*|} o1 o2
+
+derive gEq Op1
+instance == Op1 where (==) o1 o2 = gEq{|*|} o1 o2
+
+instance < Op2 where
+    (<) o1 o2 = (toString o1) < (toString o2)
+
+instance < Op1 where
+    (<) o1 o2 = (toString o1) < (toString o2)
\ No newline at end of file
diff --git a/sem.icl b/sem.icl
index 23fb04a..77e6554 100644
--- a/sem.icl
+++ b/sem.icl
@@ -3,11 +3,12 @@ implementation module sem
 import qualified Data.Map as Map
 
 from Data.Func import $
-from StdFunc import o
+from StdFunc import o, id
 
 import Control.Monad
 import Data.Either
 import Data.Monoid
+import Data.List 
 
 import StdString
 import StdList
@@ -58,8 +59,23 @@ inEnv (x, sc) m = local scope m
 	where
 		scope e = 'Map'.put x sc ('Map'.del x e )
 
+fresh :: Infer Type
+fresh = (gets id) >>= \vars-> (put $ tail vars) >>| (pure $ IdType $ head vars)
+
 class infer a :: a -> Infer Type
 
+op2Type :: Op2 -> Infer Type
+op2Type op  | elem op [BiPlus, BiMinus, BiTimes, BiDivide, BiMod]
+                = pure (IntType ->> IntType ->> IntType)
+            | elem op [BiEquals, BiUnEqual]
+                = fresh >>= \t1-> fresh >>= \t2-> pure (t1 ->> t2 ->> BoolType)
+            | elem op [BiLesser, BiGreater, BiLesserEq, BiGreaterEq]
+                = pure (IntType ->> IntType ->> BoolType)
+            | elem op [BiAnd, BiOr]
+                = pure (BoolType ->> BoolType ->> BoolType)
+            | op == BiCons 
+                = fresh >>= \t1-> pure (t1 ->> ListType t1 ->> ListType t1)
+
 instance infer Expr where
 	infer (VarExpr _ vd) = undef
 	infer (Op2Expr _ e1 op e2) = case op of