X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=src%2Fparse.icl;h=acd7d9c5941ada0eb377ad866065ca65d57b93e7;hb=fa2b27e75142781978149dc3e906e8b5aae8e603;hp=56bc554a605794a58c39c5a7b363636dda1d30f8;hpb=c126dc3a1f66f959407cf3cf33bcba01142591c6;p=cc1516.git diff --git a/src/parse.icl b/src/parse.icl index 56bc554..acd7d9c 100644 --- a/src/parse.icl +++ b/src/parse.icl @@ -18,14 +18,11 @@ import yard import lex parser :: LexerOutput -> ParserOutput -parser (Left e) = Left $ toString $ LexError e -parser (Right r) = case runParser parseProgram r of - (Right p, _) = Right p - (Left e, _) = Left $ toString e +parser (Left e) = Left e +parser (Right r) = fst $ runParser parseProgram r parseProgram :: Parser Token AST parseProgram = liftM2 AST (many parseVarDecl) (some parseFunDecl) - <* satTok EndOfFileToken parseFunDecl :: Parser Token FunDecl parseFunDecl = liftM5 FunDecl @@ -168,7 +165,7 @@ parseTuple p = satTok BraceOpenToken *> <* satTok BraceCloseToken trans2 :: TokenValue (TokenValue -> a) -> Parser Token a -trans2 t f = liftM (f o thd3) $ satTok t +trans2 t f = liftM (\{token}->f token) $ satTok t trans1 :: TokenValue a -> Parser Token a trans1 t r = trans2 t $ const r @@ -176,14 +173,13 @@ trans1 t r = trans2 t $ const r derive gPrint TokenValue derive gEq TokenValue satTok :: TokenValue -> Parser Token Token -satTok t = top >>= \tok=:(pos1, pos2, tv) -> if (eq t tok) - (return tok) - (fail (printToString tv+++printToString t, pos1)) +satTok t = top >>= \tok=:{line,column,token} -> if (eq t token) + (return tok) (fail PositionalError line column ("ParseError: Unexpected token: " +++ printToString token)) where - eq (IdentToken _) (_, _, IdentToken _) = True - eq (NumberToken _) (_, _, NumberToken _) = True - eq (CharToken _) (_, _, CharToken _) = True - eq x (_, _, y) = gEq {|*|} x y + eq (IdentToken _) (IdentToken _) = True + eq (NumberToken _) (NumberToken _) = True + eq (CharToken _) (CharToken _) = True + eq x y = gEq {|*|} x y parseSepList :: TokenValue (Parser Token a) -> Parser Token [a] parseSepList sep p = @@ -191,7 +187,7 @@ parseSepList sep p = (liftM pure p) <|> pure empty parseIdent :: Parser Token String -parseIdent = trans2 (IdentToken []) (\(IdentToken e).toString e) +parseIdent = trans2 (IdentToken "") (\(IdentToken e).toString e) instance toString AST where toString (AST v f) = concat (