X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;ds=sidebyside;f=parse.icl;h=ab575b64db2c00781b9ad6ef339695e9731b36f0;hb=e34b5f088ff9a86da61afbbe91c2c88f895673c7;hp=a507ab3ae662f53dc51067f7e97caabcfc74b480;hpb=8c4ec1c3287d6c6ddefd22ef608a4d97693e7e85;p=cc1516.git diff --git a/parse.icl b/parse.icl index a507ab3..ab575b6 100644 --- a/parse.icl +++ b/parse.icl @@ -7,9 +7,11 @@ from StdFunc import const, o import Data.Either import Data.Maybe import Data.Functor +import Data.Tuple import Control.Monad import Control.Applicative import Data.Func +import StdMisc from Data.List import intercalate, replicate, instance Functor [] from Text import class Text(concat), instance Text String import GenPrint @@ -25,7 +27,7 @@ parser ts = case runParser parseProgram ts of x = fst x parseProgram :: Parser Token AST -parseProgram = AST <$> (many parseVarDecl) <*> (some parseFunDecl) +parseProgram = AST <$> some parseFunDecl parseFunDecl :: Parser Token FunDecl parseFunDecl = liftM6 FunDecl @@ -39,7 +41,7 @@ parseFunDecl = liftM6 FunDecl parseStmt :: Parser Token Stmt parseStmt = parseIfStmt <|> parseWhileStmt <|> parseSColon parseAssStmt <|> parseSColon parseReturnStmt <|> - (FunStmt <$> parseSColon parseFunCall) + (parseSColon parseFunCall >>= \(ident, args)->pure $ FunStmt ident args) where parseSColon :: (Parser Token a) -> Parser Token a parseSColon p = p <* satTok SColonToken @@ -78,7 +80,7 @@ parseFunType = satTok DoubleColonToken *> parseFT parseVarDecl :: Parser Token VarDecl parseVarDecl = liftM4 VarDecl peekPos - (parseType <|> trans1 VarToken VarType ) + ((parseType >>= \t->pure $ Just t)<|> trans1 VarToken Nothing) (parseIdent <* satTok AssignmentToken) (parseExpr <* satTok SColonToken) @@ -122,7 +124,8 @@ parseExpr = //Operators in order of binding strength parseBasicExpr :: Parser Token Expr parseBasicExpr = peekPos >>= \pos -> (TupleExpr pos <$> (parseTuple parseExpr)) <|> - (FunExpr pos <$> parseFunCall) <|> + (parseFunCall >>= \(ident, args)->parseFieldSelectors >>= \fs-> + pure $ FunExpr pos ident args fs) <|> parseBBraces parseExpr <|> trans1 EmptyListToken (EmptyListExpr pos) <|> trans1 TrueToken (BoolExpr pos True) <|> @@ -132,18 +135,19 @@ parseExpr = //Operators in order of binding strength (Op1Expr pos <$> parseOp1 <*> parseExpr) <|> (VarExpr pos <$> parseVarDef) -parseFunCall :: Parser Token FunCall -parseFunCall = FunCall <$> parseIdent <*> - (parseBBraces $ parseSepList CommaToken parseExpr) +parseFunCall :: Parser Token (String, [Expr]) +parseFunCall = tuple <$> parseIdent <*> ( + (parseBBraces $ parseSepList CommaToken parseExpr) <|> pure []) parseVarDef :: Parser Token VarDef -parseVarDef = liftM2 VarDef - parseIdent - (many (satTok DotToken *> ( +parseVarDef = liftM2 VarDef parseIdent parseFieldSelectors + +parseFieldSelectors :: Parser Token [FieldSelector] +parseFieldSelectors = 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)))) + (parseIdent >>= \i.if (i == "snd") (pure FieldSnd) empty))) parseOp1 :: Parser Token Op1 parseOp1 = trans1 DashToken UnMinus <|> trans1 ExclamationToken UnNegation