X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=src%2Fyard.icl;h=9ed60773de8155dd7c3242ac9f12ea24c8e6b66b;hb=3d1c57710eb0b86f13df392f03131157aec22c21;hp=81e58837495df4a2fa86e9f7c817835b8cda89fa;hpb=f63b1c16836bebf6eef2baa5f20d4d6ebc73e4dd;p=cc1516.git diff --git a/src/yard.icl b/src/yard.icl index 81e5883..9ed6077 100644 --- a/src/yard.icl +++ b/src/yard.icl @@ -12,6 +12,7 @@ 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" @@ -36,15 +37,15 @@ instance Applicative (Parser a) where instance Monad (Parser a) where bind p f = Parser \i -> case runParser p i of (Right r, rest) = runParser (f r) rest - (Left e, rest) = (Left e, rest) + (Left e, _) = (Left e, i) 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 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, i) + (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 @@ -65,6 +66,29 @@ peek = Parser \i -> case i of [] = (Left ParseError, []) [x:xs] = (Right x, [x:xs]) +//runs the left parser until the right parser succeeds. Returns the result of the left parser +//Note: if the right parser consumes input then this input is lost! +//If the left parser fails before the right parser succeeds the whole parser fails +until :: (Parser a b) (Parser a c) -> Parser a [b] +until p guard = try $ until` p guard [] + where + until` :: (Parser a b) (Parser a c) [b] -> Parser a [b] + until` p guard acc = Parser \i -> case runParser guard i of + (Right _, rest) = (Right acc, rest) + (Left _, _) = case runParser p i of + (Right r, rest) = runParser (until` p guard [r:acc]) rest + (Left e, _) = (Left e, i) + try :: (Parser a b) -> Parser a b + try p = Parser \i -> case runParser p i of + (Left e, _) = (Left e, i) + (Right r, rest) = (Right r, rest) + + +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 @@ -75,4 +99,4 @@ 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