X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=parse.icl;h=a79ad2fcfe52aeb7391e7701a1040504e9c4dde3;hb=74b900cf6db033a51e177f7f85d835dae44217e5;hp=e4bac8be0e6e4833d4ca9722fe489530eadec697;hpb=74b8c52b6f00b15208e55e0e6c1ed56ce888f0db;p=cc1516.git diff --git a/parse.icl b/parse.icl index e4bac8b..a79ad2f 100644 --- a/parse.icl +++ b/parse.icl @@ -34,12 +34,12 @@ parseProgram = many parseLetDecl >>= \fds1-> parseLetDecl :: Parser Token FunDecl parseLetDecl = peekPos >>= \p-> satTok LetToken >>| - (optional parseFunType) >>= \mt-> + parseFunType >>= \mt-> parseIdent >>= \f-> satTok AssignmentToken >>| parseExpr >>= \e-> satTok SColonToken >>| - pure (FunDecl p f [] mt [] [ReturnStmt $ Just e]) + pure (FunDecl p f [] (Just mt) [] [ReturnStmt $ Just e]) parseFunDecl :: Parser Token FunDecl parseFunDecl = liftM6 FunDecl @@ -85,14 +85,15 @@ parseStmt = parseIfStmt <|> parseWhileStmt <|> parseOneLine = pure <$> parseStmt parseFunType :: Parser Token Type -parseFunType = parseFT +parseFunType = parseFT >>= \t -> case t of + t1 ->> t2 = pure t + simpleT = pure $ FuncType simpleT where parseFT :: Parser Token Type parseFT = (liftM2 (->>) (parseSF <* satTok ArrowToken) (parseFT)) <|> - parseSF <|> - (FuncType <$> parseType) + parseSF parseSF :: Parser Token Type - parseSF = parseBBraces parseFT + parseSF = parseBBraces parseFT <|> parseType parseVarDecl :: Parser Token VarDecl parseVarDecl = liftM4 VarDecl @@ -112,7 +113,9 @@ parseType = (IdType <$> parseIdent) parseExpr :: Parser Token Expr -parseExpr = //Operators in order of binding strength +parseExpr = parseValueExpr <|> parseLambda +parseValueExpr :: Parser Token Expr +parseValueExpr = //Operators in order of binding strength parseOpR (trans1 ColonToken BiCons) $ parseOpR (trans1 PipesToken BiOr) $ parseOpR (trans1 AmpersandsToken BiAnd) $ @@ -153,6 +156,11 @@ parseExpr = //Operators in order of binding strength pure $ FunExpr pos ident args fs) <|> (VarExpr pos <$> parseVarDef) +parseLambda :: Parser Token Expr +parseLambda = LambdaExpr <$> peekPos + <*> (satTok BackslashToken *> some parseIdent) + <*> (satTok ArrowToken *> parseExpr) + makeStrExpr :: Pos [Char] -> Expr makeStrExpr p [] = EmptyListExpr p makeStrExpr p [x:xs] = Op2Expr p (CharExpr zero x) BiCons (makeStrExpr p xs) @@ -207,16 +215,16 @@ peekPos = fst <$> peek derive gPrint TokenValue derive gEq TokenValue satTok :: TokenValue -> Parser Token Token -satTok t = top >>= \tok=:({line,col},token) -> if (eq t token) +satTok t = top >>= \tok=:({line,col},token) -> if (tokEq t token) (pure tok) (fail PositionalError line col ("ParseError: Unexpected token: " +++ printToString token +++ "\nExpected: " +++ printToString t)) - where - eq (IdentToken _) (IdentToken _) = True - eq (NumberToken _) (NumberToken _) = True - eq (CharToken _) (CharToken _) = True - eq (StringToken _) (StringToken _) = True - eq x y = gEq {|*|} x y + +tokEq (IdentToken _) (IdentToken _) = True +tokEq (NumberToken _) (NumberToken _) = True +tokEq (CharToken _) (CharToken _) = True +tokEq (StringToken _) (StringToken _) = True +tokEq x y = gEq {|*|} x y parseSepList :: TokenValue (Parser Token a) -> Parser Token [a] parseSepList sep p =