X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=src%2Fyard.icl;h=582ea1d6a25e5a8eb2980456c3166622e22263de;hb=3275e6545ebf0901e962065416cf95f5b35fa828;hp=2f3c90ac6b3b7bbeebce21036777a4712a302f7d;hpb=b4636110ab65f233ed40d4390b62c7799df3c949;p=cc1516.git diff --git a/src/yard.icl b/src/yard.icl index 2f3c90a..582ea1d 100644 --- a/src/yard.icl +++ b/src/yard.icl @@ -3,19 +3,30 @@ implementation module yard 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 + 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 @@ -32,7 +43,15 @@ instance Alternative (Parser a) where empty = Parser \i -> (Left ParseError, i) (<|>) p1 p2 = Parser \i -> case runParser p1 i of (Right r, rest) = (Right r, rest) - (Left _, rest) = runParser p2 i + (Left e1, rest) = case runParser p2 i of + (Left e2, rest) = (Left $ e1+e2, rest) + (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) + (Right r, rest) = (Right r, rest) fail :: Parser a b fail = empty @@ -42,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