Merge branch 'master' of github.com:dopefishh/cc1516

[cc1516.git] / sem.icl

diff --git a/sem.icl b/sem.icl
index d909508..ef825e4 100644 (file)
--- a/sem.icl
+++ b/sem.icl
@@ -3,13 +3,13 @@ implementation module sem
 import qualified Data.Map as Map
 
 from Data.Func import $
-from StdFunc import o, flip, const
+from StdFunc import o, flip, const, id
 
 import Control.Monad
 import Data.Either
 import Data.Maybe
 import Data.Monoid
-import Data.List
+import Data.List 
 
 import StdString
 import StdList
@@ -90,8 +90,27 @@ 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)
+
+op1Type :: Op1 -> Infer Type
+op1Type UnNegation = pure $ (BoolType ->> BoolType)
+op1Type UnMinus = pure $ (IntType ->> IntType)
+
 instance infer Expr where
        infer (VarExpr _ vd) = undef
        infer (Op2Expr _ e1 op e2) = case op of