From: Mart Lubbers <mart@martlubbers.net>
Date: Wed, 13 Apr 2016 11:19:48 +0000 (+0200)
Subject: Merge branch 'master' of github.com:dopefishh/cc1516
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=2953e6cc260d8243e5434b7e787258ab073d34d2;p=cc1516.git

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

2953e6cc260d8243e5434b7e787258ab073d34d2
diff --cc examples/varEx.spl
index 4c809fb,fbecf04..fa77063
--- a/examples/varEx.spl
+++ b/examples/varEx.spl
@@@ -17,12 -17,10 +17,16 @@@ var l = 1:2:[]
  
  var m = 4;
  var n = m + 2;
- var q = v + 2;
++//var q = v + 2;
 +//var z = !v;
 +
 +var pim = 'a' == 'b';
- var pim = 'a' + 'b';
- var pim = ('a':[]) == ('b':[]);
++//var pim = 'a' + 'b';
++//var pim = ('a':[]) == ('b':[]);
+ //var o = v + 2;
+ //var p = !v;
+ 
+ var q = facR(3);
  
  facR(n) :: Int -> Int {
      return 5;
diff --cc sem.dcl
index dbf1014,0d4a7d6..e981361
--- a/sem.dcl
+++ b/sem.dcl
@@@ -9,7 -9,7 +9,8 @@@ from StdOverloaded import class toStrin
  	= ParseError Pos String 
  	| UnifyError Pos Type Type 
      | FieldSelectorError Pos Type FieldSelector 
 +	| OperatorError Pos Op2 Type
+     | UndeclaredVariableError Pos String
  	| Error String
  :: Gamma
  :: SemOutput :== Either [SemError] (AST, Gamma)
diff --cc sem.icl
index 77131b0,8c40fb5..c7a41e9
--- a/sem.icl
+++ b/sem.icl
@@@ -60,10 -60,8 +60,12 @@@ instance toString SemError wher
          toString p,
          "SemError: Cannot select ", toString fs, " from type: ",
          toString t]
 +	toString (OperatorError p o t) = concat [
 +		toString p, 
 +		"SemError: No ", toString o, " for type ",
 +		toString t]
+     toString (UndeclaredVariableError p ident) = concat [
+         toString p, "SemError: identifier: ", ident, " undefined."]
  
  sem :: AST -> SemOutput
  sem (AST vd fd) = case runStateT m ('Map'.newMap, getRandomStream 1) of
@@@ -95,25 -90,43 +99,33 @@@ typeExpr (Op1Expr p UnNegation expr) = 
  typeExpr (Op1Expr p UnMinus expr) = unify IntType expr
  typeExpr (TupleExpr p (e1, e2)) = typeExpr e1 
      >>= \t1-> typeExpr e2 >>= \t2-> pure $ TupleType (t1, t2)
 -//Int
 -typeExpr (Op2Expr p e1 BiPlus e2) = unify IntType e1 >>| unify IntType e2
 -typeExpr (Op2Expr p e1 BiMinus e2) = unify IntType e1 >>| unify IntType e2
 -typeExpr (Op2Expr p e1 BiTimes e2) = unify IntType e1 >>| unify IntType e2
 -typeExpr (Op2Expr p e1 BiDivide e2) = unify IntType e1 >>| unify IntType e2
 -typeExpr (Op2Expr p e1 BiMod e2) = unify IntType e1 >>| unify IntType e2
 -//bool, char of int
 -typeExpr (Op2Expr p e1 BiEquals e2) = typeExpr e1 >>= \t1 -> unify t1 e2 
 -    >>| pure BoolType //todo, actually check t1 in Char,Bool,Int
 -typeExpr (Op2Expr p e1 BiUnEqual e2) = typeExpr (Op2Expr p e1 BiEquals e2)
 -//char of int
 -typeExpr (Op2Expr p e1 BiLesser e2) = typeExpr e1 >>= \t1 -> unify t1 e2 
 -    >>| pure BoolType //todo, actually check t1 in Char, Int
 -typeExpr (Op2Expr p e1 BiGreater e2) = typeExpr (Op2Expr p e1 BiLesser e2)
 -typeExpr (Op2Expr p e1 BiLesserEq e2) = typeExpr (Op2Expr p e1 BiLesser e2)
 -typeExpr (Op2Expr p e1 BiGreaterEq e2) = typeExpr (Op2Expr p e1 BiLesser e2)
 -//bool
 -typeExpr (Op2Expr p e1 BiAnd e2) = unify BoolType e1 >>| unify BoolType e2
 -typeExpr (Op2Expr p e1 BiOr e2) = unify BoolType e1 >>| unify BoolType e2
 -//a
 -typeExpr (Op2Expr p e1 BiCons e2) = typeExpr e1 >>= \t1-> typeExpr e2 
 -    >>= \t2-> unify (ListType t1) t2
 +typeExpr (Op2Expr p e1 op e2)
 +| isMember op [BiPlus, BiMinus, BiTimes, BiDivide, BiMod] =
 +	typeOp2 e1 e2 op [IntType]
 +| isMember op [BiEquals, BiUnEqual] =
 +	typeOp2 e1 e2 op [IntType, BoolType, CharType]
 +| isMember op [BiLesser, BiGreater, BiLesserEq, BiGreaterEq] =
 +	typeOp2 e1 e2 op [IntType, CharType]
 +| isMember op [BiAnd, BiOr] =
 +	typeOp2 e1 e2 op [BoolType]
 +| op == BiCons = typeExpr e1 >>= \t1-> typeExpr e2 
 +	>>= \t2-> unify (ListType t1) t2
  typeExpr (EmptyListExpr p) = freshIdent >>= \frsh-> let t = IdType frsh in
      putIdent frsh t >>| pure t
- typeExpr (FunExpr p (FunCall fid args)) = undef
 +//ignore field selectors
+ typeExpr (FunExpr p (FunCall f es)) = gets (\(st, r)->'Map'.get f st)
+     >>= \mt-> case mt of
+         Nothing = let t = IdType f in putIdent f t >>| pure t
+         Just t = unifyApp t es
  typeExpr (VarExpr p (VarDef ident fs)) = gets (\(st, r)->'Map'.get ident st)
-         >>= \mt->case mt of
-             Nothing = let t = IdType ident in putIdent ident t >>| pure t
-             Just t = unify t fs
+     >>= \mt->case mt of
+         Nothing = liftT $ Left $ UndeclaredVariableError p ident
+         Just t = unify t fs
+ 
+ unifyApp :: Type [Expr] -> Env Type
+ unifyApp t [] = pure t //whoop whoop, functions can return functions
+ unifyApp (tf1 ->> tf2) [t1:ts] = (->>) <$> unify tf1 t1 <*> (unifyApp tf2 ts)
+ unifyApp t1 t2 = liftT $ Left $ UnifyError zero t1 (IdType "[expressions, FIXME")
  
  class unify a :: Type a -> Env Type