From: pimjager Date: Tue, 1 Mar 2016 21:23:15 +0000 (+0100) Subject: now accepts complete Errors X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=0deec3b5e205945dc8cf8a00ca8cff4c96f42552;p=cc1516.git now accepts complete Errors --- diff --git a/src/lex.icl b/src/lex.icl index ac5168f..b3c76cd 100644 --- a/src/lex.icl +++ b/src/lex.icl @@ -72,4 +72,4 @@ lexToken = lexEscape = fromJust <$> (( lexOp "a" (toChar 7) <|> lexOp "b" '\b' <|> lexOp "f" '\f' <|> lexOp "n" '\n' <|> lexOp "r" '\t' <|> lexOp "v" '\v' <|> - lexOp "'" '\'') ("Unknown escape", 0)) + lexOp "'" '\'') LexError "Unknown escape") diff --git a/src/parse.icl b/src/parse.icl index fed0760..7320b11 100644 --- a/src/parse.icl +++ b/src/parse.icl @@ -178,7 +178,7 @@ 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)) + (fail Unexpected (printToString tv) (pos1, pos2)) where eq (IdentToken _) (_, _, IdentToken _) = True eq (NumberToken _) (_, _, NumberToken _) = True diff --git a/src/yard.dcl b/src/yard.dcl index 178356a..a40b42d 100644 --- a/src/yard.dcl +++ b/src/yard.dcl @@ -8,7 +8,7 @@ from Control.Monad import class Monad from Control.Applicative import class Applicative, class Alternative import Data.Void -:: Error = ParseError | LexError String | Unexpected String Int +:: Error = ParseError | LexError String | Unexpected String (Int, Int) :: Parser a b = Parser ([a] -> (Either Error b, [a])) instance Functor (Parser a) @@ -20,7 +20,7 @@ instance toString Error runParser :: (Parser a b) [a] -> (Either Error b, [a]) -() :: (Parser a b) (String, Int) -> Parser a b +() :: (Parser a b) Error -> Parser a b fail :: Parser a b top :: Parser a a peek :: Parser a a diff --git a/src/yard.icl b/src/yard.icl index a78dcbb..7b74454 100644 --- a/src/yard.icl +++ b/src/yard.icl @@ -17,7 +17,8 @@ import Data.Void instance toString Error where toString ParseError = "General parse error" toString (LexError e) = "Lexer error: " +++ e - toString (Unexpected e pos) = "Unexpected " +++ e +++ " at position " +++ (toString pos) + toString (Unexpected e (l,c)) = "Unexpected " +++ e +++ " at " + +++ (toString l) +++ ":" +++ (toString c) runParser :: (Parser a b) [a] -> (Either Error b, [a]) runParser (Parser f) i = f i @@ -48,9 +49,9 @@ instance Alternative (Parser a) where (Right r, rest) = (Right r, rest) //Try the parser, if it fails decorate the error with Expected of the given String and position -() :: (Parser a b) (String, Int) -> Parser a b -() p (e,pos) = Parser \i -> case runParser p i of - (Left e1, rest) = (Left $ e1 + Unexpected e pos, rest) +() :: (Parser a b) Error -> Parser a b +() p e = Parser \i -> case runParser p i of + (Left e1, rest) = (Left $ e1 + e, rest) (Right r, rest) = (Right r, rest) fail :: Parser a b