From d223266f509eb74929928174dbe015c2498c1bdc Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Mon, 29 Feb 2016 12:58:18 +0100
Subject: [PATCH] liftm voor statement

---
 src/grammar.txt |  2 +-
 src/parse.icl   | 55 ++++++++++++++++++++++---------------------------
 2 files changed, 26 insertions(+), 31 deletions(-)

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 @@
 <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
--- 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
-- 
2.20.1