Deprecated: The each() function is deprecated. This message will be suppressed on further calls in /home/zhenxiangba/zhenxiangba.com/public_html/phproxy-improved-master/index.php on line 456
-- ============================================================ --
--
-- 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 ++ "\"")
-- ============================================================ --