From 74b8c52b6f00b15208e55e0e6c1ed56ce888f0db Mon Sep 17 00:00:00 2001
From: pimjager <pim@pimjager.nl>
Date: Thu, 26 May 2016 12:31:12 +0200
Subject: [PATCH] Basic Let functionality

---
 examples/tempTest.spl |  8 ++++----
 grammar/grammar.txt   |  4 +++-
 lex.dcl               |  1 +
 lex.icl               |  1 +
 parse.icl             | 26 ++++++++++++++++++++------
 sem.icl               | 11 ++++++++---
 6 files changed, 37 insertions(+), 14 deletions(-)

diff --git a/examples/tempTest.spl b/examples/tempTest.spl
index 3da3635..23421f0 100644
--- a/examples/tempTest.spl
+++ b/examples/tempTest.spl
@@ -1,17 +1,17 @@
+Let Int a = 4;
+
 mapP1(xs) {
     if(isEmpty(xs)) {
         return [];
     } else {
         return (xs.hd + 1) : mapP1(xs.tl);
     }
-}
-empt() {
-    
 }
 main() {
     [Int] x = [];
     [Int] y = [];
+    Int z = a();
     x = mapP1(x);
     y = mapP1(x);
-    return;
+    return a() + 5;
 }
\ No newline at end of file
diff --git a/grammar/grammar.txt b/grammar/grammar.txt
index 4325c92..24cd657 100644
--- a/grammar/grammar.txt
+++ b/grammar/grammar.txt
@@ -1,4 +1,6 @@
-<Prog>         ::= <FunDecl>+
+<Prog>         ::= <LetDecl>*
+                    <FunDecl>+
+<LetDecl>      ::= 'Let' <type>? <id> '=' <Expr> ';'
 <FunDecl>      ::= <id> '(' <Type>* ')' ['::' <FunType] '{' <VarDecl>* <Stmt>+ '}'
 <FunType>      ::= <VoidType> ['->' <FunType>]
                  | '(' <FunType> ')'
diff --git a/lex.dcl b/lex.dcl
index 535487d..dd7d28e 100644
--- a/lex.dcl
+++ b/lex.dcl
@@ -23,6 +23,7 @@ from AST import :: Pos
 	| IntTypeToken      // Int keyword
 	| CharTypeToken     // Char keyword
 	| BoolTypeToken     // Bool keyword
+    | LetToken          // Let keyword
 	//Two character tokens
 	| DoubleColonToken  // ::
 	| NotEqualToken     // !=
diff --git a/lex.icl b/lex.icl
index a792ce3..6072bce 100644
--- a/lex.icl
+++ b/lex.icl
@@ -48,6 +48,7 @@ lexToken =
 	lexKw "True" TrueToken <|> lexKw "False" FalseToken <|>
 	lexKw "Int" IntTypeToken <|> lexKw "Bool" BoolTypeToken <|>
 	lexKw "Char" CharTypeToken <|>
+    lexKw "Let" LetToken <|>
 	//Character tokens
 	lexEscape <|> lexCharacter <|>
 	//Two char ops tokens
diff --git a/parse.icl b/parse.icl
index e13b870..e4bac8b 100644
--- a/parse.icl
+++ b/parse.icl
@@ -27,14 +27,26 @@ parser ts = case runParser parseProgram ts of
 	x = fst x
 
 parseProgram :: Parser Token AST
-parseProgram = AST <$> some parseFunDecl
+parseProgram = many parseLetDecl >>= \fds1->
+                some parseFunDecl >>= \fds2->
+                pure $ AST (fds1++fds2)
+
+parseLetDecl :: Parser Token FunDecl
+parseLetDecl = peekPos >>= \p->
+                satTok LetToken >>|
+                (optional parseFunType) >>= \mt->
+                parseIdent >>= \f->
+                satTok AssignmentToken >>|
+                parseExpr >>= \e->
+                satTok SColonToken >>|
+                pure (FunDecl p f [] mt [] [ReturnStmt $ Just e])
 
 parseFunDecl :: Parser Token FunDecl
 parseFunDecl = liftM6 FunDecl
     (peekPos)
     (parseIdent)
 	(parseBBraces $ parseSepList CommaToken parseIdent)
-	(optional parseFunType)
+	(optional (satTok DoubleColonToken *> parseFunType))
 	(satTok CBraceOpenToken *> many parseVarDecl)
 	(many parseStmt <* satTok CBraceCloseToken)
 
@@ -73,13 +85,14 @@ parseStmt = parseIfStmt <|> parseWhileStmt <|>
 		parseOneLine = pure <$> parseStmt
 
 parseFunType :: Parser Token Type
-parseFunType = satTok DoubleColonToken *> parseFT
+parseFunType = parseFT
 	where
         parseFT :: Parser Token Type
 		parseFT = (liftM2 (->>) (parseSF <* satTok ArrowToken) (parseFT)) <|>
-			parseSF
+			parseSF <|> 
+            (FuncType <$> parseType)
 		parseSF :: Parser Token Type
-		parseSF = parseBBraces parseFT <|> parseType
+		parseSF = parseBBraces parseFT
 
 parseVarDecl :: Parser Token VarDecl
 parseVarDecl = liftM4 VarDecl
@@ -196,7 +209,8 @@ derive gEq TokenValue
 satTok :: TokenValue -> Parser Token Token
 satTok t = top >>= \tok=:({line,col},token) -> if (eq t token)
 	(pure tok) (fail <?> PositionalError line col
-		("ParseError: Unexpected token: " +++ printToString token))
+		("ParseError: Unexpected token: " +++ printToString token 
+            +++ "\nExpected: " +++ printToString t))
 	where
 		eq (IdentToken _) (IdentToken _) = True
 		eq (NumberToken _) (NumberToken _) = True
diff --git a/sem.icl b/sem.icl
index f87e5bb..68e0859 100644
--- a/sem.icl
+++ b/sem.icl
@@ -110,7 +110,7 @@ instance Typeable Type where
     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 (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
@@ -383,13 +383,18 @@ instance type FunDecl where
         let given = foldr (->>) result argTs_ in 
         (case expected of
             Nothing = pure zero
+            Just (FuncType expected_) = lift (unify expected_ given)
             Just expected_ = lift (unify expected_ given))
         >>= \s3 ->
         let ftype = subst (compose s3 $ compose s2 s1) given in
-        generalize ftype >>= \t->
+        (case expected of
+            Just (FuncType _) = pure (FuncType ftype)
+            _                 = pure ftype)
+        >>= \ftype_->
+        generalize ftype_ >>= \t->
         putGamma outerScope >>|
         changeGamma (extend f t) >>| 
-        pure (compose s3 $ compose s2 s1, FunDecl p f args (Just ftype) tVds stmts_)
+        pure (compose s3 $ compose s2 s1, FunDecl p f args (Just ftype_) tVds stmts_)
 
 instance type [a] | type a where
     type []     = pure (zero, [])
-- 
2.20.1