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 library in Haskell -- *************************************************************************** module Parselib where infixl 8 `apP`, `doP`, `bindP` infixr 6 `consP` infix 4 `as` infixr 2 `orelse` -- *************************************************************************** -- the parsing monad is backtracking + state -- we make it a new type so that type errors give comprehensible messages. -- *************************************************************************** data Parser t a = Parser ([t] -> [(a,[t])]) unParser (Parser p) = p unitP x = Parser (\ts -> [(x,ts)]) Parser p `bindP` f = Parser (\ts -> [(v,ts'') | (u,ts') <- p ts, (v,ts'') <- unParser (f u) ts']) -- *************************************************************************** -- primitives that depend on the monad -- *************************************************************************** failure = Parser (\_ -> []) Parser p `orelse` Parser q = Parser (\ts -> p ts++q ts) cut (Parser p) = Parser (\ts -> [head (p ts)]) token = Parser (\ts -> case ts of t:ts' -> [(t,ts')] [] -> []) eof = Parser (\ts -> case ts of t:ts' -> [] [] -> [((),[])]) -- *************************************************************************** -- operations useful in any monad -- *************************************************************************** mapP f x = x `bindP` \v -> unitP (f v) binP op x y = x `bindP` \v -> y `bindP` \w -> unitP (v `op` w) apP = binP (\f x -> f x) doP = binP const consP = binP (:) pairP = binP (\x y->(x,y)) -- *************************************************************************** -- low-level parsing primitives -- *************************************************************************** satisfy p = token `bindP` \tok -> if p tok then unitP tok else failure literal t = satisfy (==t) -- *************************************************************************** -- combinators for repetition -- *************************************************************************** many p = cut (some p `orelse` unitP []) some p = p `consP` many p -- *************************************************************** -- combinators for expression parsing -- *************************************************************** lassoc op e = unitP (foldl f) `apP` e `apP` many (op `pairP` e) where f e (o,e') = o e e' -- *************************************************************************** -- combinators for lexical analysis -- *************************************************************************** string :: Eq a => [a] -> Parser a [a] string = foldr consP (unitP []) . map literal anyOf f = foldr orelse failure . map f word = satisfy isAlpha `consP` many (satisfy isAlphaNum) number = some (satisfy isDigit) -- *************************************************************************** -- combinators for creating and parsing tagged tokens -- *************************************************************************** x `as` t = x `bindP` \v -> unitP (v,t) kind t = token `bindP` \(v,t') -> if t==t' then unitP v else failure strip t xs = [(v,t') | (v,t')<-xs, t/=t'] -- *************************************************************************** -- invoking a parser -- *************************************************************************** parse p ts = case unParser (p `doP` eof) ts of [] -> error "No parse!\n" (v,_):_ -> v