From: pimjager Date: Mon, 29 Feb 2016 12:29:47 +0000 (+0100) Subject: Improved error type with position annotation X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=a0cf809b53126a797667fb43f8496a7cc2b7252e;p=cc1516.git Improved error type with position annotation --- diff --git a/src/parse.icl b/src/parse.icl index bc93239..5fc8f8c 100644 --- a/src/parse.icl +++ b/src/parse.icl @@ -173,7 +173,7 @@ trans1 :: TokenValue a -> Parser Token a trans1 t r = trans2 t $ const r satTok :: TokenValue -> Parser Token Token -satTok t = satisfy ((===) t) +satTok t = top >>= \tok=:(pos, tv) -> if (t === tok) (return tok) (fail ("Token", pos)) parseSepList :: TokenValue (Parser Token a) -> Parser Token [a] parseSepList sep p = diff --git a/src/yard.dcl b/src/yard.dcl index 266eb75..73a82c0 100644 --- a/src/yard.dcl +++ b/src/yard.dcl @@ -7,7 +7,7 @@ from Data.Functor import class Functor from Control.Monad import class Monad from Control.Applicative import class Applicative, class Alternative -:: Error = ParseError | LexError String | Expected [String] +:: Error = ParseError | LexError String | Expected [String] Int :: Parser a b = Parser ([a] -> (Either Error b, [a])) instance Functor (Parser a) @@ -18,6 +18,7 @@ instance Alternative (Parser a) instance toString Error runParser :: (Parser a b) [a] -> (Either Error b, [a]) +() :: (Parser a b) (String, Int) -> Parser a b fail :: Parser a b top :: Parser a a satisfy :: (a -> Bool) -> Parser a a diff --git a/src/yard.icl b/src/yard.icl index 5460312..278bac8 100644 --- a/src/yard.icl +++ b/src/yard.icl @@ -15,8 +15,8 @@ instance toString Error where toString (LexError e) = "Lexer error: " +++ e instance + Error where - (+) (Expected as) (Expected bs) = Expected (as++bs) - (+) _ r = r + (+) (Expected as _) (Expected bs p) = Expected (as++bs) p + (+) _ r = r runParser :: (Parser a b) [a] -> (Either Error b, [a]) runParser (Parser f) i = f i @@ -41,9 +41,10 @@ instance Alternative (Parser a) where (Right r, rest) = (Right r, rest) (Left e2, rest) = (Left (e1+e2), rest) - :: (Parser a b) String -> Parser a b - p e = Parser \i -> case runParser p i of - (Left e1, rest) = (Left (e1+(Expected [e])), 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) = let error = (e1+(Expected [e] pos)) in (Left error, rest) (Right r, rest) = (Right r, rest) fail :: Parser a b