From: pimjager <pim@pimjager.nl>
Date: Fri, 20 May 2016 15:44:11 +0000 (+0200)
Subject: Merge branch 'master' of https://github.com/dopefishh/cc1516
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=14e9a339d121ce18c420e4cb99f6bad86d1a5b45;p=cc1516.git

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

14e9a339d121ce18c420e4cb99f6bad86d1a5b45
diff --cc examples/codeGen.spl
index f41897d,77b02a1..7e78897
--- a/examples/codeGen.spl
+++ b/examples/codeGen.spl
@@@ -26,13 -26,6 +26,15 @@@ isE(x) :: [a] -> Bool 
      }
  }
  
 +test() {
 +    var x =print(5);
++    var f = read;
++    var y = read();
 +    print(True);
 +    print('a');
 +    print('h' : 'o' : 'i' : []);
 +}
 +
  main() {
   //   [Int] x2 = 0 : x1;
   //   [Int] x3 = [];
diff --cc sem.icl
index 75b5585,e714dbf..5ebbc48
--- a/sem.icl
+++ b/sem.icl
@@@ -210,37 -213,30 +213,38 @@@ instance infer Expr wher
          let given = t1 ->> tv in 
          op1Type op >>= \expected ->
          lift (unify expected given) >>= \s2 ->
 -        pure (compose s2 s1, subst s2 tv)
 +        pure (compose s2 s1, subst s2 tv, Op1Expr p op e1)
  
 -    EmptyListExpr _ = (\tv->(zero,tv)) <$> fresh
 +    EmptyListExpr _ = (\tv->(zero,tv,e)) <$> fresh
  
 -    TupleExpr _ (e1, e2) = 
 -        infer e1 >>= \(s1, t1) -> 
 -        infer e2 >>= \(s2, t2) ->
 -        pure (compose s2 s1, TupleType (t1,t2))
 +    TupleExpr p (e1, e2) = 
 +        infer e1 >>= \(s1, t1, e1_) -> 
 +        infer e2 >>= \(s2, t2, e2_) ->
 +        pure (compose s2 s1, TupleType (t1,t2), TupleExpr p (e1_,e2_))
  
 -    FunExpr _ f args fs = //todo: fieldselectors
 +    FunExpr p f args fs = //todo: fix print
          lookup f >>= \expected ->
 -        let accST = (\(s,ts) e->infer e >>= \(s_,et)->pure (compose s_ s,ts++[et])) in
 -        foldM accST (zero,[]) args >>= \(s1, argTs)->
 +        let accST = (\(s,ts,es) e->infer e >>= \(s_,et,e_)-> pure (compose s_ s,ts++[et],es++[e_])) in
 +        foldM accST (zero,[],[]) args >>= \(s1, argTs, args_)->
-         fresh >>= \tv->
-         let given = foldr (->>) tv argTs in
-         lift (unify expected given) >>= \s2->
-         let fReturnType = subst s2 tv in
-         foldM foldFieldSelectors fReturnType fs >>= \returnType ->
-         (case f of
-             "print" = case head argTs of
-                 IntType = pure "1printint"
-                 CharType = pure "1printchar"
-                 BoolType = pure "1printbool"
-                 ListType (CharType) = pure "1printstr"
-                 t = liftT $ Left $ SanityError p ("can not print " +++ toString t)
-             _ = pure f) >>= \newF->
-         pure (compose s2 s1, returnType, FunExpr p newF args_ fs)
+         fresh >>= \tv->case expected of
 -			FuncType t = pure (s1, t)
 -			_ = (let given = foldr (->>) tv argTs in
 -        		lift (unify expected given) >>= \s2->
 -        		let fReturnType = subst s2 tv in
 -        		foldM foldFieldSelectors fReturnType fs >>= \returnType ->
 -        		pure (compose s2 s1, returnType))
 -
 -    IntExpr _ _ = pure $ (zero, IntType)
 -    BoolExpr _ _ = pure $ (zero, BoolType)
 -    CharExpr _ _ = pure $ (zero, CharType)
++            FuncType t = pure (s1, t, e)
++            _ = (let given = foldr (->>) tv argTs in
++                lift (unify expected given) >>= \s2->
++                let fReturnType = subst s2 tv in
++                foldM foldFieldSelectors fReturnType fs >>= \returnType ->
++                (case f of
++                    "print" = case head argTs of
++                        IntType = pure "1printint"
++                        CharType = pure "1printchar"
++                        BoolType = pure "1printbool"
++                        ListType (CharType) = pure "1printstr"
++                        t = liftT $ Left $ SanityError p ("can not print " +++ toString t)
++                    _ = pure f) >>= \newF->
++                pure (compose s2 s1, returnType, FunExpr p newF args_ fs))
 +
 +    IntExpr _ _ = pure $ (zero, IntType, e)
 +    BoolExpr _ _ = pure $ (zero, BoolType, e)
 +    CharExpr _ _ = pure $ (zero, CharType, e)
  
  foldFieldSelectors :: Type FieldSelector -> Typing Type 
  foldFieldSelectors (ListType t) (FieldHd) = pure t