Added op2type function

diff --git a/AST.dcl b/AST.dcl
index 45eab9e..e9c6944 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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