liftm voor statement

diff --git a/src/grammar.txt b/src/grammar.txt
index 3eb7146..ce6732b 100644 (file)
--- a/src/grammar.txt
+++ b/src/grammar.txt
@@ -13,7 +13,7 @@
 <BinAndExpr>   ::= <CompareExpr> ['&&' <BinAndExpr>]
 <CompareExpr>  ::= <PlusMinExpr> [('==' | '<' | '>' | '<=' | '>=' | '!=') <CompareExpr>]
 <PlusMinExpr>  ::= <TimesDivExpr> (('+' | '-') <TimesDivExpr>)*
-<TimesDivExpr> ::= <BasicExpr> ('*' | '/' | '%'] <BasicExpr>)*
+<TimesDivExpr> ::= <BasicExpr> (['*' | '/' | '%'] <BasicExpr>)*
 <BasicExpr>    ::= <id> <FieldSels>
                  | <Op1> <Expr>
                  | <int>

diff --git a/src/parse.icl b/src/parse.icl
index e22cba4..bc93239 100644 (file)
--- 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