From: Mart Lubbers Date: Mon, 29 Feb 2016 12:55:35 +0000 (+0100) Subject: alles liftm behalve parseseplist X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=798defc398c2e3df810cc8fd3dccf861103006a5;p=cc1516.git alles liftm behalve parseseplist --- diff --git a/src/parse.dcl b/src/parse.dcl index abfb8b4..62a0461 100644 --- a/src/parse.dcl +++ b/src/parse.dcl @@ -10,7 +10,7 @@ import lex :: AST = AST [VarDecl] [FunDecl] :: VarDecl = VarDecl Type String Expr :: Type - = TupleType Type Type + = TupleType (Type, Type) | ListType Type | IdType String | IntType @@ -26,7 +26,7 @@ import lex | BoolExpr Bool | FunExpr FunCall | EmptyListExpr - | TupleExpr Expr Expr + | TupleExpr (Expr, Expr) :: VarDef = VarDef String [FieldSelector] :: FieldSelector = FieldHd | FieldTl | FieldFst | FieldSnd :: Op1 = UnNegation | UnMinus diff --git a/src/parse.icl b/src/parse.icl index 0f0f42c..b3046e0 100644 --- a/src/parse.icl +++ b/src/parse.icl @@ -67,15 +67,6 @@ parseStmt = parseIfStmt <|> parseWhileStmt <|> //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 - -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 <|> (liftM (FunType []) parseVoidOrType)) @@ -100,12 +91,9 @@ parseType = trans1 CharTypeToken CharType <|> trans1 BoolTypeToken BoolType <|> (liftM ListType (parseBSqBraces parseType)) <|> - (liftM2 TupleType - (satTok BraceOpenToken *> parseType <* satTok CommaToken) - (parseType <* satTok BraceCloseToken)) <|> + (liftM TupleType (parseTuple parseType)) <|> (liftM IdType parseIdent) -//TODO hieronder omzetten naar liftm notatie parseExpr :: Parser Token Expr parseExpr = //Operators in order of binding strength parseOpR (trans1 ColonToken BiCons) $ @@ -135,37 +123,48 @@ parseExpr = //Operators in order of binding strength parseBasicExpr :: Parser Token Expr parseBasicExpr = - (satTok BraceOpenToken *> parseExpr <* satTok CommaToken - >>= \e1->parseExpr <* satTok BraceCloseToken - >>= \e2->pure $ TupleExpr e1 e2) <|> - (parseFunCall >>= \fc->pure $ FunExpr fc) <|> + (liftM TupleExpr (parseTuple parseExpr)) <|> + (liftM FunExpr parseFunCall) <|> parseBBraces parseExpr <|> trans1 EmptyListToken EmptyListExpr <|> - trans2 TrueToken (const $ BoolExpr True) <|> - trans2 FalseToken (const $ BoolExpr False) <|> + trans1 TrueToken (BoolExpr True) <|> + trans1 FalseToken (BoolExpr False) <|> trans2 (NumberToken zero) (\(NumberToken i)->IntExpr i) <|> trans2 (CharToken zero) (\(CharToken c)->CharExpr c) <|> - (parseOp1 >>= \o->parseExpr >>= \e.pure $ Op1Expr o e) <|> - (parseVarDef >>= \ve->pure $ VarExpr ve) + (liftM2 Op1Expr parseOp1 parseExpr) <|> + (liftM VarExpr parseVarDef) parseFunCall :: Parser Token FunCall -parseFunCall = parseIdent <* satTok BraceOpenToken - >>= \i->parseSepList CommaToken parseExpr - <* satTok BraceCloseToken >>= \es->pure $ FunCall i es +parseFunCall = liftM2 FunCall + parseIdent (parseBBraces $ parseSepList CommaToken parseExpr) parseVarDef :: Parser Token VarDef -parseVarDef = parseIdent - >>= \i-> many (satTok DotToken *> ( +parseVarDef = liftM2 VarDef + parseIdent + (many (satTok DotToken *> ( (parseIdent >>= (\i.if (i == "hd") (pure FieldHd) empty)) <|> (parseIdent >>= \i.if (i == "tl") (pure FieldTl) empty) <|> (parseIdent >>= \i.if (i == "fst") (pure FieldFst) empty) <|> - (parseIdent >>= \i.if (i == "snd") (pure FieldSnd) empty)) - ) >>= \f->pure $ VarDef i f + (parseIdent >>= \i.if (i == "snd") (pure FieldSnd) empty)))) parseOp1 :: Parser Token Op1 parseOp1 = trans1 DashToken UnMinus <|> trans1 ExclamationToken UnNegation +parseBBraces :: (Parser Token a) -> Parser Token a +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 + +parseTuple :: (Parser Token a) -> Parser Token (a, a) +parseTuple p = satTok BraceOpenToken *> + (liftM2 (\a->(\b->(a,b))) (p <* satTok CommaToken) p) + <* satTok BraceCloseToken + trans2 :: TokenValue (TokenValue -> a) -> Parser Token a trans2 t f = satTok t >>= \(_, r).pure (f r) @@ -184,7 +183,7 @@ satTok t = satisfy $ eq t parseSepList :: TokenValue (Parser Token a) -> Parser Token [a] parseSepList sep p = (some (p <* satTok sep) >>= \es->p >>= \e.pure $ reverse [e:es]) <|> - (p >>= \e->pure [e]) <|> pure [] + (liftM pure p) <|> pure empty parseIdent :: Parser Token String parseIdent = trans2 (IdentToken []) (\(IdentToken e).toString e) @@ -237,7 +236,7 @@ instance print VarDecl where print (VarDecl t i e) = print t ++ [" ":i:"=":print e] ++ [";"] instance print Type where - print (TupleType t1 t2) = ["(":print t1] ++ [",":print t2] ++ [")"] + print (TupleType (t1, t2)) = ["(":print t1] ++ [",":print t2] ++ [")"] print (ListType t) = ["[":print t] ++ ["]"] print (IdType s) = print s print IntType = print "Int" @@ -280,4 +279,4 @@ instance print Expr where print (BoolExpr b) = [toString b] print (FunExpr fc) = print fc print EmptyListExpr = ["[]"] - print (TupleExpr e1 e2) = ["(":print e1] ++ [",":print e2] ++ [")"] + print (TupleExpr (e1, e2)) = ["(":print e1] ++ [",":print e2] ++ [")"]