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

diff --combined sem.icl
index eb626f6,a041cee..43df3a3
--- 1/sem.icl
--- 2/sem.icl
+++ b/sem.icl
@@@ -41,26 -41,47 +41,47 @@@ sem (AST vd fd) = case runStateT m ('Ma
  where 
      m :: Env ([VarDecl], [FunDecl])
      m = mapM semVarDecl vd >>= \vds ->
-         mapM semFunDecl fd >>= \fds -> 
-         pure (vds, fds)
+         mapM semFunDecl fd >>= \fds1 -> 
+         mapM semFunDecl fds1 >>= \fds2 -> 
+         pure (vds, fds2)
  
  semFunDecl :: FunDecl -> Env FunDecl
  semFunDecl fd=:(FunDecl p f args mt vds stmts) = 
-     saveGamma >>= \gamma ->
      (case mt of
-         Nothing = let t = IdType f in putIdent f t >>| pure t
+         Nothing = genType args >>= \infft->putIdent f infft >>| pure infft
          Just t = putIdent f t >>| pure t) >>= \ft ->
-       matchFunctions args ft >>|
+     saveGamma >>= \gamma ->
+       matchFunctions args ft >>= \tres->
      mapM semVarDecl vds >>= \newvds->
-     mapM_ (checkStmt $ resultType ft) stmts >>| 
-     restoreGamma gamma >>| 
-       pure (FunDecl p f args mt newvds stmts) 
- 
- matchFunctions :: [String] Type -> Env Void
- matchFunctions [] (_ ->> _) = liftT $ Left $ Error "Niet genoeg argumentenerror"
- matchFunctions [] t = pure Void
+     mapM (checkStmt tres) stmts >>= \newstmts->
+       pure IntType >>= \returntype->
+       case mt of
+               Nothing = reconstructType args returntype 
+               >>= \ftype->restoreGamma gamma 
+                       >>| putIdent f ftype >>| pure (
+                       FunDecl p f args (Just ftype) newvds newstmts) 
+               Just t = restoreGamma gamma 
+                       >>| pure (FunDecl p f args mt newvds newstmts) 
+ 
+ reconstructType :: [String] Type -> Env Type
+ reconstructType [] t = pure t
+ reconstructType [x:xs] t = gets (\(st, r)->'Map'.get x st)
+       >>= \mtype->case mtype of
+               Nothing = liftT $ Left $ Error "Not used ????"
+               Just type = reconstructType xs t >>= \resttype->pure (type ->> resttype)
+ 
+ genType :: [String] -> Env Type
+ genType [] = freshIdent >>= \fi->pure $ IdType fi
+ genType [x:xs] = liftM2 (->>) (freshIdent >>= \fi->pure $ IdType fi)
+       (genType xs)
+ 
+ matchFunctions :: [String] Type -> Env Type
+ matchFunctions [] (_ ->> _) = liftT $ Left $ Error "Not enough arguments"
+ matchFunctions _ (VoidType ->> _) = liftT $ Left $ Error "Cannot have a void type in the middle of the function definition"
  matchFunctions [x:xs] (t1 ->> t2) = 
        modify (\(st, r)->('Map'.put x t1 st, r)) >>| matchFunctions xs t2
+ matchFunctions [] t = pure t
+ matchFunctions _ t = liftT $ Left $ Error "Too much argumnts"
  
  semVarDecl :: VarDecl -> Env VarDecl
  semVarDecl (VarDecl pos type ident ex) = unify type ex
@@@ -105,6 -126,7 +126,6 @@@ typeExpr (VarExpr p (VarDef ident fs)) 
      >>= \mt->case mt of
          Nothing = liftT $ Left $ UndeclaredVariableError p ident
          Just t = unify t fs
 -
  typeOp2 :: Expr Expr Op2 [Type] Type -> Env Type
  typeOp2 e1 e2 op ts ret = typeExpr e1 >>= \t1-> typeExpr e2 >>= \t2->
      unify t1 t2 >>= \t3->if (isMember t3 ts) (pure ret)
@@@ -144,8 -166,8 +165,8 @@@ instance unify Expr wher
                        "Expression cannot be a higher order function. Yet..."
        unify VoidType e = liftT $ Left $ ParseError (extrPos e)
                        "Expression cannot be a Void type."
-       unify (IdType _) e = liftT $ Left $ ParseError (extrPos e)
-                       "Expression cannot be an polymorf type."
+ //    unify (IdType _) e = liftT $ Left $ ParseError (extrPos e)
+ //                    "Expression cannot be an polymorf type."
      unify VarType e = typeExpr e
      //we have to cheat to decorate the error, can be done nicer?
      unify t e = StateT $ \s0 -> let res = runStateT m s0 in case res of
@@@ -248,4 -270,4 +269,4 @@@ saveGamma :: Env Gamm
  saveGamma = get
  
  restoreGamma :: Gamma -> Env Void
- restoreGamma g = put g
+ restoreGamma (oldstate, _) = gets snd >>= \newr->put (oldstate, newr)