Basic Let functionality
authorpimjager <pim@pimjager.nl>
Thu, 26 May 2016 10:31:12 +0000 (12:31 +0200)
committerpimjager <pim@pimjager.nl>
Thu, 26 May 2016 10:31:12 +0000 (12:31 +0200)
examples/tempTest.spl
grammar/grammar.txt
lex.dcl
lex.icl
parse.icl
sem.icl

index 3da3635..23421f0 100644 (file)
@@ -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
index 4325c92..24cd657 100644 (file)
@@ -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 (file)
--- 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 (file)
--- 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
index e13b870..e4bac8b 100644 (file)
--- 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 (file)
--- 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, [])