X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=src%2Fparse.icl;h=acd7d9c5941ada0eb377ad866065ca65d57b93e7;hb=fa2b27e75142781978149dc3e906e8b5aae8e603;hp=7320b1123fde5c4f75e3c29e84cdb5fbed6ef665;hpb=0deec3b5e205945dc8cf8a00ca8cff4c96f42552;p=cc1516.git diff --git a/src/parse.icl b/src/parse.icl index 7320b11..acd7d9c 100644 --- a/src/parse.icl +++ b/src/parse.icl @@ -18,11 +18,8 @@ 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 - (Right p, x) = Left "Unparsed tokens: "//TODO - (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) @@ -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 Unexpected (printToString tv) (pos1, pos2)) +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 =