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 ==================================================
--
-- Taken from Graham Hutton, Higher-order functions for parsing,
-- Journal of Functional Programming, 2(3):323-343, July 1992.
module
infixr "!!"; -- "or", alternation in BNF
infixr ".."; -- "then", juxtaposition in BNF
infixr "x.."; -- Drop left-hand value
infixr "..x"; -- Drop right-hand value
infixl "$opt"; -- Optional component, [_] in BNF
infixl "$using"; -- Semantic actions
infixl "$return"; -- Constant result value
export succeed, fail, satisfy, literal, string, -- Primitives
(!!), (..), $opt, many, some, -- Combinators
$using, (x..), (..x), $return, -- Values
number, word, any, nibble, symbol; -- Useful
-- Auxilliary Definitions ===============================================
--
-- cons :: (*a # List *a) -> List *a
-- foldr :: (*a -> *b -> *b) -> *b -> List *a -> *b
--
-- type Parser *a *b == List *a -> List (*b # List *a)
rec cons (x,xs) = x.xs
and foldr op a [] = a
|| foldr op a (x.xs) = op x (foldr op a xs)
-- Primitive Parsers ====================================================
--
-- succeed :: *b -> Parser *a *b
-- fail :: Parser *a *b
-- satisfy :: (*a -> Bool) -> Parser *a *a
-- literal :: *a -> Parser (pos *a) *a
-- string :: List *a -> Parser *a (List *a)
and succeed v = \inp . [(v,inp)]
and fail = \inp . []
and satisfy p [] = fail []
|| satisfy p (x.xs) = if (p x) then (succeed x xs) else (fail xs)
and literal x = satisfy (=x)
and string [] = succeed []
|| string (x.xs) = (literal x .. string xs) $using cons
-- Combinators ==========================================================
--
-- (!!) :: Parser *a *b -> Parser *a *b -> Parser *a *b
-- (..) :: Parser *a *b -> Parser *a *c -> Parser *a (*b # *c)
-- $opt :: Parser *a *b -> *b -> Parser *a *b
-- many :: Parser *a *b -> Parser *a (List *b)
-- some :: Parser *a *b -> Parser *a (List *b)
and p1 !! p2 = \inp . p1 inp @ p2 inp
and p1 .. p2 = \inp . [((v1,v2),out2) ;; (v1,out1) <- p1 inp ;
(v2,out2) <- p2 out1]
and p $opt v = \inp . let (v',out) = hd ((p !! succeed v) inp)
in [(v',out)]
and many p = ((p .. many p) $using cons) $opt []
and some p = (p .. many p) $using cons
-- Manipulating Values ==================================================
--
-- $using :: Parser *a *b -> (*b -> *c) -> Parser *a *c
-- (x..) :: Parser *a *b -> Parser *a *c -> Parser *a *c
-- (..x) :: Parser *a *b -> Parser *a *c -> Parser *a *b
-- $return :: Parser *a *b -> *c -> Parser *a *c
and p $using f = \inp . [(f v,out) ;; (v,out) <- p inp]
and p1 x.. p2 = (p1 .. p2) $using snd
and p1 ..x p2 = (p1 .. p2) $using fst
and p $return v = p $using (\x.v)
-- Useful Parsers =======================================================
--
-- number :: Parser Char (List Char)
-- word :: Parser Char (List Char)
-- any :: (*a -> Parser *b *c) -> (List *a) -> Parser *b *c
-- nibble :: Parser Char *a -> Parser Char *a
-- symbol :: (List Char) -> Parser Char (List Char)
and number = some (satisfy isdigit)
and word = some (satisfy isalpha)
and any p = foldr ((!!) o p) fail
and nibble p = let white = many (any literal " \t\n")
in white x.. p ..x white
and symbol = nibble o string
end
-- ======================================================================