From: Mart Lubbers Date: Mon, 29 Feb 2016 12:35:02 +0000 (+0100) Subject: liftm voor de helft X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=1e30f02a706b29dae471b6526e7fd0e4bf5bf483;p=cc1516.git liftm voor de helft --- diff --git a/src/parse.dcl b/src/parse.dcl index baef545..abfb8b4 100644 --- a/src/parse.dcl +++ b/src/parse.dcl @@ -8,7 +8,7 @@ import lex :: ParserOutput :== Either String AST :: AST = AST [VarDecl] [FunDecl] -:: VarDecl = VarDecl String Type Expr +:: VarDecl = VarDecl Type String Expr :: Type = TupleType Type Type | ListType Type diff --git a/src/parse.icl b/src/parse.icl index e60ad17..0f0f42c 100644 --- a/src/parse.icl +++ b/src/parse.icl @@ -53,8 +53,8 @@ parseStmt = parseIfStmt <|> parseWhileStmt <|> parseIfStmt = liftM3 IfStmt (satTok IfToken *> parseBBraces parseExpr) (parseBlock <|> parseOneLine) - (optional (satTok ElseToken *> (parseBlock <|> parseOneLine) - ) >>= pure o fromMaybe []) + (liftM (fromMaybe []) + (optional (satTok ElseToken *> (parseBlock<|> parseOneLine)))) parseWhileStmt :: Parser Token Stmt parseWhileStmt = satTok WhileToken *> @@ -73,39 +73,39 @@ parseBBraces p = satTok BraceOpenToken *> p <* satTok BraceCloseToken parseBCBraces :: (Parser Token a) -> Parser Token a parseBCBraces p = satTok CBraceOpenToken *> p <* satTok CBraceCloseToken +parseBSqBraces :: (Parser Token a) -> Parser Token a +parseBSqBraces p = satTok SquareOpenToken *> p <* satTok SquareCloseToken + parseFunType :: Parser Token FunType -parseFunType = satTok DoubleColonToken *> - (parseInOutType <|> (parseVoidOrType >>= \t->pure $ FunType [] t)) +parseFunType = satTok DoubleColonToken *> + (parseInOutType <|> (liftM (FunType []) parseVoidOrType)) where parseInOutType :: Parser Token FunType - parseInOutType = some parseType <* satTok ArrowToken - >>= \intypes-> parseVoidOrType - >>= \outtypes->pure $ FunType intypes outtypes + parseInOutType = liftM2 FunType + (some parseType <* satTok ArrowToken) parseVoidOrType parseVoidOrType :: Parser Token (Maybe Type) parseVoidOrType = (satTok VoidToken *> pure Nothing) <|> - (parseType >>= \type->pure $ Just type) + (liftM Just parseType) parseVarDecl :: Parser Token VarDecl -parseVarDecl = +parseVarDecl = liftM3 VarDecl (parseType <|> trans1 VarToken VarType ) - >>= \t->parseIdent <* satTok AssignmentToken - >>= \i->parseExpr <* satTok SColonToken - >>= \e->pure $ VarDecl i t e + (parseIdent <* satTok AssignmentToken) + (parseExpr <* satTok SColonToken) parseType :: Parser Token Type parseType = trans1 IntTypeToken IntType <|> trans1 CharTypeToken CharType <|> trans1 BoolTypeToken BoolType <|> - (satTok SquareOpenToken *> parseType <* satTok SquareCloseToken - >>= \t.pure $ ListType t) <|> - (satTok BraceOpenToken *> parseType <* satTok CommaToken - >>= \t1->parseType <* satTok BraceCloseToken - >>= \t2->pure $ TupleType t1 t2) <|> - (parseIdent >>= \e.pure $ IdType e) <|> - empty + (liftM ListType (parseBSqBraces parseType)) <|> + (liftM2 TupleType + (satTok BraceOpenToken *> parseType <* satTok CommaToken) + (parseType <* satTok BraceCloseToken)) <|> + (liftM IdType parseIdent) +//TODO hieronder omzetten naar liftm notatie parseExpr :: Parser Token Expr parseExpr = //Operators in order of binding strength parseOpR (trans1 ColonToken BiCons) $ @@ -234,7 +234,7 @@ instance print FunType where [if (isEmpty at) "" "->":maybe ["Void"] print rt] instance print VarDecl where - print (VarDecl i t e) = print t ++ [" ":i:"=":print e] ++ [";"] + print (VarDecl t i e) = print t ++ [" ":i:"=":print e] ++ [";"] instance print Type where print (TupleType t1 t2) = ["(":print t1] ++ [",":print t2] ++ [")"]