From: Mart Lubbers Date: Mon, 29 Feb 2016 11:58:18 +0000 (+0100) Subject: liftm voor statement X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=d223266f509eb74929928174dbe015c2498c1bdc;p=cc1516.git liftm voor statement --- diff --git a/src/grammar.txt b/src/grammar.txt index 3eb7146..ce6732b 100644 --- a/src/grammar.txt +++ b/src/grammar.txt @@ -13,7 +13,7 @@ ::= ['&&' ] ::= [('==' | '<' | '>' | '<=' | '>=' | '!=') ] ::= (('+' | '-') )* - ::= ('*' | '/' | '%'] )* + ::= (['*' | '/' | '%'] )* ::= | | diff --git a/src/parse.icl b/src/parse.icl index e22cba4..bc93239 100644 --- a/src/parse.icl +++ b/src/parse.icl @@ -3,14 +3,14 @@ implementation module parse import StdString import StdTuple import StdList -from StdFunc import const +from StdFunc import const, o import Data.Either import Data.Functor import Data.Maybe import Control.Monad import Control.Applicative import Data.Func -from Data.List import intercalate, replicate +from Data.List import intercalate, replicate, instance Functor [] from Text import class Text(concat), instance Text String import yard @@ -23,54 +23,49 @@ parser (Right r) = case runParser parseProgram r of (Left e, _) = Left $ toString e parseProgram :: Parser Token AST -parseProgram = many parseVarDecl - >>= \vd->some parseFunDecl - >>= \fd->pure $ AST vd fd +parseProgram = liftM2 AST (many parseVarDecl) (some parseFunDecl) parseFunDecl :: Parser Token FunDecl -parseFunDecl = parseIdent <* satTok BraceOpenToken - >>= \ident->parseSepList CommaToken parseIdent <* satTok BraceCloseToken - >>= \args->parseFunType <* satTok CBraceOpenToken - >>= \funtype->many parseVarDecl - >>= \vardecls->many parseStmt - <* satTok CBraceCloseToken - >>= \stmts->pure $ FunDecl ident args funtype vardecls stmts +parseFunDecl = liftM5 FunDecl + (parseIdent <* satTok BraceOpenToken) + (parseSepList CommaToken parseIdent <* satTok BraceCloseToken) + (parseFunType <* satTok CBraceOpenToken) + (many parseVarDecl) + (many parseStmt <* satTok CBraceCloseToken) parseStmt :: Parser Token Stmt -parseStmt = parseIfStmt <|> - parseWhileStmt <|> - parseSColon parseAssStmt <|> - parseSColon parseReturnStmt <|> - (parseSColon parseFunCall >>= \fc->pure $ FunStmt fc) +parseStmt = parseIfStmt <|> parseWhileStmt <|> + parseSColon parseAssStmt <|> parseSColon parseReturnStmt <|> + (liftM FunStmt (parseSColon parseFunCall)) where parseSColon :: (Parser Token a) -> Parser Token a parseSColon p = p <* satTok SColonToken parseReturnStmt :: Parser Token Stmt - parseReturnStmt = satTok ReturnToken - *> optional parseExpr >>= \me->pure $ ReturnStmt me + parseReturnStmt = + satTok ReturnToken *> liftM ReturnStmt (optional parseExpr) parseAssStmt :: Parser Token Stmt - parseAssStmt = parseVarDef <* satTok AssignmentToken - >>= \var-> parseExpr >>= \expr->pure $ AssStmt var expr + parseAssStmt = + liftM2 AssStmt (parseVarDef <* satTok AssignmentToken) parseExpr parseIfStmt :: Parser Token Stmt - parseIfStmt = satTok IfToken - *> parseBBraces parseExpr - >>= \pred->(parseBlock <|> parseOneLine) - >>= \thens->optional ( - satTok ElseToken *> (parseBlock <|> parseOneLine) - )>>= \elses->pure $ IfStmt pred thens (fromMaybe [] elses) + parseIfStmt = liftM3 IfStmt + (satTok IfToken *> parseBBraces parseExpr) + (parseBlock <|> parseOneLine) + (optional (satTok ElseToken *> (parseBlock <|> parseOneLine) + ) >>= pure o fromMaybe []) parseWhileStmt :: Parser Token Stmt - parseWhileStmt = satTok WhileToken *> parseBBraces parseExpr - >>= \pred->parseBlock >>= \body->pure $ WhileStmt pred body + parseWhileStmt = satTok WhileToken *> + liftM2 WhileStmt (parseBBraces parseExpr) parseBlock parseBlock :: Parser Token [Stmt] parseBlock = parseBCBraces (many parseStmt) parseOneLine :: Parser Token [Stmt] - parseOneLine = parseStmt >>= \s->pure [s] + //first pure makes singleton list from the statement + parseOneLine = liftM pure parseStmt parseBBraces :: (Parser Token a) -> Parser Token a parseBBraces p = satTok BraceOpenToken *> p <* satTok BraceCloseToken