Merge branch 'master' of github.com:dopefishh/cc1516
authorMart Lubbers <mart@martlubbers.net>
Wed, 13 Apr 2016 11:19:48 +0000 (13:19 +0200)
committerMart Lubbers <mart@martlubbers.net>
Wed, 13 Apr 2016 11:19:48 +0000 (13:19 +0200)
1  2 
examples/varEx.spl
sem.dcl
sem.icl

@@@ -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
+++ 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
+++ 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