X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=src%2Fyard.icl;h=582ea1d6a25e5a8eb2980456c3166622e22263de;hb=3275e6545ebf0901e962065416cf95f5b35fa828;hp=932999a6a40966fe8bf6fab6179b496e96a573b9;hpb=6e527e30012f8809594452cb9559b301b4a8afc6;p=cc1516.git diff --git a/src/yard.icl b/src/yard.icl index 932999a..582ea1d 100644 --- a/src/yard.icl +++ b/src/yard.icl @@ -12,20 +12,21 @@ import Data.Either import Control.Monad import Control.Applicative from Data.Func import $ +import Data.Void instance toString Error where toString ParseError = "General parse error" toString (LexError e) = "Lexer error: " +++ e - toString (Expected ts pos) = "Expected " +++ (concat $ intersperse ", " ts) - +++ " at position " +++ (toString pos) - -instance + Error where - (+) (Expected as _) (Expected bs p) = Expected (as++bs) p - (+) _ r = r + toString (Unexpected e pos) = "Unexpected " +++ e +++ " at position " +++ (toString pos) runParser :: (Parser a b) [a] -> (Either Error b, [a]) runParser (Parser f) i = f i +instance + Error where + (+) ParseError r = r + (+) r ParseError = r + (+) r _ = r + instance Functor (Parser a) where fmap f m = liftM f m @@ -43,13 +44,13 @@ instance Alternative (Parser a) where (<|>) p1 p2 = Parser \i -> case runParser p1 i of (Right r, rest) = (Right r, rest) (Left e1, rest) = case runParser p2 i of + (Left e2, rest) = (Left $ e1+e2, rest) (Right r, rest) = (Right r, rest) - (Left e2, rest) = (Left (e1+e2), 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) + (Left e1, rest) = (Left $ e1 + Unexpected e pos, rest) (Right r, rest) = (Right r, rest) fail :: Parser a b @@ -60,11 +61,24 @@ top = Parser \i -> case i of [] = (Left ParseError, []) [x:xs] = (Right x, xs) +peek :: Parser a a +peek = Parser \i -> case i of + [] = (Left ParseError, []) + [x:xs] = (Right x, [x:xs]) + +eof :: Parser a Void +eof = Parser \i -> case i of + [] = (Right Void, []) + _ = (Left ParseError, i) + satisfy :: (a -> Bool) -> Parser a a satisfy f = top >>= \r -> if (f r) (return r) fail +check :: (a -> Bool) -> Parser a a +check f = peek >>= \r -> if (f r) (return r) fail + item :: a -> Parser a a | Eq a item a = satisfy ((==)a) list :: [a] -> Parser a [a] | Eq a -list as = mapM item as +list as = mapM item as \ No newline at end of file