From 1d051aa39779841a8ffa6c640f308d33726ad7d4 Mon Sep 17 00:00:00 2001
From: pimjager <pim@pimjager.nl>
Date: Mon, 25 Apr 2016 21:03:57 +0200
Subject: [PATCH] infer voor expressions afgemaakt

---
 sem.icl | 55 +++++++++++++++++++++++++++++++++----------------------
 1 file changed, 33 insertions(+), 22 deletions(-)

diff --git a/sem.icl b/sem.icl
index e05a1e4..6108e3a 100644
--- 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)
 
-- 
2.20.1