From: Mart Lubbers <mart@martlubbers.net>
Date: Fri, 20 May 2016 14:31:15 +0000 (+0200)
Subject: add constant functs
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=53c97f5e2ed9c8b4364bac1dedc7e482af583787;p=cc1516.git

add constant functs
---

diff --git a/examples/high.spl b/examples/high.spl
index 6750769..bee8ccb 100644
--- a/examples/high.spl
+++ b/examples/high.spl
@@ -3,7 +3,11 @@ plus(x, y) {
 }
 
 main (){
-	
-	var f = plus();
+	var a = read;
+	var b = read();
+	var c = plus;
+	var d = plus(1);
+	var e = plus(1, 2);
+	var f = d(41);
 	return 5;
 }
diff --git a/sem.icl b/sem.icl
index 0c5b552..668bbeb 100644
--- a/sem.icl
+++ b/sem.icl
@@ -51,7 +51,7 @@ variableStream = map toString [1..]
 defaultGamma :: Gamma //includes all default functions
 defaultGamma = extend "print" (Forall ["a"] ((IdType "a") ->> VoidType))
                 $ extend "isEmpty" (Forall ["a"] ((ListType (IdType "a")) ->> BoolType))
-                $ extend "read" (Forall [] CharType)
+                $ extend "read" (Forall [] (FuncType CharType))
                 zero
 
 sem :: AST -> Either [SemError] AST
@@ -102,10 +102,12 @@ instance Typeable Type where
     ftv (TupleType (t1, t2))    = ftv t1 ++ ftv t2
     ftv (ListType t)            = ftv t
     ftv (IdType tvar)           = [tvar]
+    ftv (FuncType t)            = ftv t
     ftv (t1 ->> t2)             = ftv t1 ++ ftv t2
     ftv _                       = []
     subst s (TupleType (t1, t2))= TupleType (subst s t1, subst s t2)
     subst s (ListType t1)       = ListType (subst s t1)
+    subst s (FuncType t)         = FuncType (subst s t)
     subst s (t1 ->> t2)         = (subst s t1) ->> (subst s t2)
     subst s t1=:(IdType tvar)   = 'Map'.findWithDefault t1 tvar s
     subst s t                   = t
@@ -223,12 +225,13 @@ instance infer Expr where
         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)->
-        fresh >>= \tv->
-        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)
+        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)