infer voor expressions afgemaakt

diff --git a/sem.icl b/sem.icl
index e05a1e4..6108e3a 100644 (file)
--- a/sem.icl
+++ b/sem.icl
@@ -11,6 +11,7 @@ import Data.Either
 import Data.Maybe
 import Data.Monoid
 import Data.List 
+import Data.Functor
 
 import StdString
 import StdList
@@ -40,6 +41,9 @@ import AST
 instance zero Gamma where
        zero = 'Map'.newMap
 
+//runInfer :: Gamma (Infer a) -> Either SemError a
+//runInfer env m = evalRWST m env variableStream
+
 variableStream :: [String]
 variableStream = map toString [1..]
 
@@ -101,8 +105,12 @@ instance toString SemError where
                "SemError: SanityError: ", e]
        toString se = "SemError: "
 
-uni :: Type Type -> Infer ()
-uni t1 t2 = tell [(t1, t2)]
+// ------------------------
+// First step: Inference
+// ------------------------
+
+unify :: Type Type -> Infer ()
+unify t1 t2 = tell [(t1, t2)]
 
 inEnv :: (String, Scheme) (Infer a) -> Infer a
 inEnv (x, sc) m = local ('Map'.put x sc) m
@@ -139,29 +147,32 @@ lookupEnv ident = asks ('Map'.get ident)
 class infer a :: a -> Infer Type
 instance infer Expr where
        infer (VarExpr _ (VarDef ident fs)) = lookupEnv ident
-       infer (Op2Expr _ e1 op e2) = case op of
-               BiPlus = pure IntType
-               BiMinus = pure IntType
-               BiTimes = pure IntType
-               BiDivide = pure IntType
-               BiMod = pure IntType
-               BiLesser = pure IntType
-               BiGreater = pure IntType
-               BiLesserEq = pure IntType
-               BiGreaterEq = pure IntType
-               BiAnd = pure BoolType
-               BiOr = pure BoolType
-               BiEquals = infer e1
-               BiUnEqual = infer e1 // maybe check e2?
-               BiCons = infer e1 >>= \it1->pure $ ListType it1
-       infer (Op1Expr _ op e) = case op of
-               UnMinus = pure IntType
-               UnNegation = pure BoolType
+    infer (Op2Expr _ e1 op e2) = 
+        infer e1 >>= \t1 -> 
+        infer e2 >>= \t2 ->
+        fresh >>= \frsh -> 
+        let given = t1 ->> (t2 ->> frsh) in
+        op2Type op >>= \expected -> 
+        unify expected given >>| 
+        return frsh
+       infer (Op1Expr _ op e) = 
+        infer e >>= \t1 -> 
+        fresh >>= \frsh -> 
+        let given = t1 ->> frsh in
+        op1Type op >>= \expected -> 
+        unify expected given >>| 
+        pure frsh
        infer (IntExpr _ _) = pure IntType
        infer (CharExpr _ _) = pure CharType
        infer (BoolExpr _ _) = pure BoolType
-       infer (FunExpr _ _ _ _) = undef
-       infer (EmptyListExpr _) = undef
+       infer (FunExpr _ f args sels) =  //todo, iets met field selectors
+        lookupEnv f >>= \expected ->
+        fresh >>= \frsh -> 
+        mapM infer args >>= \argTypes ->
+        let given = foldr (->>) frsh argTypes in
+        unify expected given >>|
+        pure frsh
+       infer (EmptyListExpr _) = ListType <$> fresh
        infer (TupleExpr _ (e1, e2)) =
                infer e1 >>= \et1->infer e2 >>= \et2->pure $ TupleType (et1, et2)