-- ============================================================ -- -- -- Parsing combinators -- -- Adapted from: Graham Hutton, Higher-order functions for parsing, -- Journal of Functional Programming, 2(3):323-343, July 1992. type Parser a = String -> [(a,String)] infixr `next` infixr `xnext` infixr `nextx` infixr `alt` infixr `using` infixr `into` infixr `return` -- Basic parsers succeed :: a -> Parser a fail :: Parser a satisfy :: (Char -> Bool) -> Parser Char literal :: Char -> Parser Char string :: String -> Parser String succeed v inp = [(v,inp)] fail inp = [] satisfy p [] = fail [] satisfy p (x:xs) = succeed x xs , p x = fail xs , otherwise literal x = satisfy (==x) string [] = succeed [] string (x:xs) = (literal x `next` string xs) `using` uncurry (:) -- Combinators alt :: Parser a -> Parser a -> Parser a next :: Parser a -> Parser b -> Parser (a,b) opt :: Parser a -> a -> Parser a many :: Parser a -> Parser [a] some :: Parser a -> Parser [a] (p1 `alt` p2) inp = p1 inp ++ p2 inp (p1 `next` p2) inp = [((v1,v2),out2) | (v1,out1) <- p1 inp, (v2,out2) <- p2 out1] (p `opt` v) inp = [(v',out)] where (v',out) = head ((p `alt` succeed v) inp) many p = ((p `next` many p) `using` uncurry (:)) `opt` [] some p = (p `next` many p) `using` uncurry (:) -- Manipulating values using :: Parser a -> (a -> b) -> Parser b into :: Parser a -> (a -> Parser b) -> Parser b xnext :: Parser a -> Parser b -> Parser b nextx :: Parser a -> Parser b -> Parser a return :: Parser a -> b -> Parser b (p `using` f) inp = [(f v,out) | (v,out) <- p inp] (p `into` f) inp = concat [f v out | (v,out) <- p inp] p1 `xnext` p2 = (p1 `next` p2) `using` snd p1 `nextx` p2 = (p1 `next` p2) `using` fst p `return` v = p `using` (const v) where const x y = x -- Miscellaneous number :: Parser Int word :: Parser String anyof :: (a -> Parser b) -> [a] -> Parser b sepby :: String -> Parser a -> Parser [a] nibble :: Parser a -> Parser a symbol :: String -> Parser String parse :: String -> Parser a -> a number = some (satisfy digit) `using` eval where digit x = ('0' <= x) && (x <= '9') eval = foldl f 0 f x y = (10*x) + val y val x = ord x - ord '0' word = some (satisfy letter) where letter x = (('a' <= x) && (x <= 'z')) || (('A' <= x) && (x <= 'Z')) anyof p = foldr (alt.p) fail sepby xs p = (p `next` ((symbol xs `xnext` sepby xs p) `opt` [])) `using` (uncurry (:)) nibble p = white `xnext` p `nextx` white where white = many (anyof literal " \t\n") symbol = nibble.string parse xs p = case (take 1 (p xs)) of [] -> error "Can't parse input string" [(v,[])] -> v [(v,ys)] -> error ("Can't parse \"" ++ ys ++ "\"") -- ============================================================ --