X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=src%2Fyard.icl;h=582ea1d6a25e5a8eb2980456c3166622e22263de;hb=3275e6545ebf0901e962065416cf95f5b35fa828;hp=546031252484cb5b98a3c0f540c5b7623bfa94e7;hpb=61fef22563cae53d4cf43680fe16703af4a1e822;p=cc1516.git diff --git a/src/yard.icl b/src/yard.icl index 5460312..582ea1d 100644 --- a/src/yard.icl +++ b/src/yard.icl @@ -4,23 +4,29 @@ import StdTuple import StdClass import StdString import StdList +import StdInt +from Data.List import intersperse +from Text import instance Text String, class Text(concat) import Data.Functor 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 - -instance + Error where - (+) (Expected as) (Expected bs) = Expected (as++bs) - (+) _ 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 @@ -38,12 +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) - :: (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) = (Left $ e1 + Unexpected e pos, rest) (Right r, rest) = (Right r, rest) fail :: Parser a b @@ -54,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