From: pimjager Date: Thu, 26 May 2016 11:13:04 +0000 (+0200) Subject: Improved Let syntax and improvements to type system X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=714af3007a284a4a9f5f820dc6f26a45034da47e;p=cc1516.git Improved Let syntax and improvements to type system --- diff --git a/examples/codeGen.spl b/examples/codeGen.spl index 3c64c1a..11a45a0 100644 --- a/examples/codeGen.spl +++ b/examples/codeGen.spl @@ -18,6 +18,8 @@ // return x3 + x1; //} +Let Int x = 5; + isE(x) :: [a] -> Bool { if (x == []) { return True; diff --git a/grammar/grammar.txt b/grammar/grammar.txt index 24cd657..e63a3f6 100644 --- a/grammar/grammar.txt +++ b/grammar/grammar.txt @@ -1,6 +1,6 @@ ::= * + - ::= 'Let' ? '=' ';' + ::= 'Let' '=' ';' ::= '(' * ')' ['::' * + '}' ::= ['->' ] | '(' ')' diff --git a/parse.icl b/parse.icl index e4bac8b..30a13a9 100644 --- a/parse.icl +++ b/parse.icl @@ -34,12 +34,12 @@ parseProgram = many parseLetDecl >>= \fds1-> parseLetDecl :: Parser Token FunDecl parseLetDecl = peekPos >>= \p-> satTok LetToken >>| - (optional parseFunType) >>= \mt-> + parseFunType >>= \mt-> parseIdent >>= \f-> satTok AssignmentToken >>| parseExpr >>= \e-> satTok SColonToken >>| - pure (FunDecl p f [] mt [] [ReturnStmt $ Just e]) + pure (FunDecl p f [] (Just mt) [] [ReturnStmt $ Just e]) parseFunDecl :: Parser Token FunDecl parseFunDecl = liftM6 FunDecl @@ -85,14 +85,15 @@ parseStmt = parseIfStmt <|> parseWhileStmt <|> parseOneLine = pure <$> parseStmt parseFunType :: Parser Token Type -parseFunType = parseFT +parseFunType = parseFT >>= \t -> case t of + t1 ->> t2 = pure t + simpleT = pure $ FuncType simpleT where parseFT :: Parser Token Type parseFT = (liftM2 (->>) (parseSF <* satTok ArrowToken) (parseFT)) <|> - parseSF <|> - (FuncType <$> parseType) + parseSF parseSF :: Parser Token Type - parseSF = parseBBraces parseFT + parseSF = parseBBraces parseFT <|> parseType parseVarDecl :: Parser Token VarDecl parseVarDecl = liftM4 VarDecl @@ -207,16 +208,16 @@ peekPos = fst <$> peek derive gPrint TokenValue derive gEq TokenValue satTok :: TokenValue -> Parser Token Token -satTok t = top >>= \tok=:({line,col},token) -> if (eq t token) +satTok t = top >>= \tok=:({line,col},token) -> if (tokEq t token) (pure tok) (fail PositionalError line col ("ParseError: Unexpected token: " +++ printToString token +++ "\nExpected: " +++ printToString t)) - where - eq (IdentToken _) (IdentToken _) = True - eq (NumberToken _) (NumberToken _) = True - eq (CharToken _) (CharToken _) = True - eq (StringToken _) (StringToken _) = True - eq x y = gEq {|*|} x y + +tokEq (IdentToken _) (IdentToken _) = True +tokEq (NumberToken _) (NumberToken _) = True +tokEq (CharToken _) (CharToken _) = True +tokEq (StringToken _) (StringToken _) = True +tokEq x y = gEq {|*|} x y parseSepList :: TokenValue (Parser Token a) -> Parser Token [a] parseSepList sep p = diff --git a/sem.icl b/sem.icl index 68e0859..484430d 100644 --- a/sem.icl +++ b/sem.icl @@ -384,13 +384,13 @@ instance type FunDecl where (case expected of Nothing = pure zero Just (FuncType expected_) = lift (unify expected_ given) - Just expected_ = lift (unify expected_ given)) - >>= \s3 -> + Just expected_ = lift (unify expected_ given) + ) >>= \s3 -> let ftype = subst (compose s3 $ compose s2 s1) given in - (case expected of - Just (FuncType _) = pure (FuncType ftype) - _ = pure ftype) - >>= \ftype_-> + (case ftype of + _ ->> _ = pure ftype + _ = pure $ FuncType ftype + ) >>= \ftype_-> generalize ftype_ >>= \t-> putGamma outerScope >>| changeGamma (extend f t) >>|