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
module Parsers where
import Char
infixr 6 <*> , <* , *> , <:*>
infixr 5 <@
infixr 4 <|>
type Parser a = String -> [(a,String)]
-- Triviaalsed parserid
failp :: Parser a
failp = const []
succp :: a -> Parser a
succp x = \cs -> [(x,cs)]
epsilon :: Parser ()
epsilon = succp ()
-- Elementaarparserid
satp :: (Char -> Bool) -> Parser Char
satp p [] = []
satp p (c:cs) = [(c,cs) | p c]
symp :: Char -> Parser Char
symp c = satp (==c)
tokp :: String -> Parser String
tokp = seqp . map symp
-- Järjestikkompositsioon
(<*>) :: Parser a -> Parser b -> Parser (a,b)
(p1 <*> p2) cs = [((v1,v2),cs2) | (v1,cs1) <- p1 cs,
(v2,cs2) <- p2 cs1]
-- Paralleelkompositsioon
(<|>) :: Parser a -> Parser a -> Parser a
(p1 <|> p2) cs = p1 cs ++ p2 cs
-- Väärtustega manipuleerimine
(<@) :: Parser a -> (a -> b) -> Parser b
(p <@ f) cs = [(f v, cs') | (v,cs') <- p cs]
-- Järjestikkompositsiooni lühendid
(<*) :: Parser a -> Parser b -> Parser a
p <* q = p <*> q <@ fst
(*>) :: Parser a -> Parser b -> Parser b
p *> q = p <*> q <@ snd
(<:*>) :: Parser a -> Parser [a] -> Parser [a]
p <:*> q = p <*> q <@ uncurry (:)
-- Iteratsioon
many :: Parser a -> Parser [a]
many p = p <:*> many p
<|> succp []
many1 :: Parser a -> Parser [a]
many1 p = p <:*> many p
-- Üldistatud järjestikkompositsioon
seqp :: [Parser a] -> Parser [a]
seqp = foldr (<:*>) (succp [])
-- Üldistatud paralleelkompositsioon
altp :: [Parser a] -> Parser a
altp = foldr (<|>) failp
-- Optsioon
optp :: Parser a -> Parser [a]
optp p = p <@ (:[])
<|> succp []
-- Üldistatud sulud
pack :: Parser a -> Parser b -> Parser c -> Parser b
pack s1 p s2 = s1 *> p <* s2
-- Eraldajatega jadad
listp :: Parser a -> Parser b -> Parser [a]
listp p s = p <:*> many (s *> p)
<|> succp []
chainl :: Parser a -> Parser (a->a->a) -> Parser a
chainl p s = p <*> many (s <*> p) <@ uncurry (foldl (flip ap2))
where ap2 (op,y) = (`op` y)
chainr :: Parser a -> Parser (a->a->a) -> Parser a
chainr p s = many (p <*> s) <*> p <@ uncurry (flip (foldr ap1))
where ap1 (x,op) = (x `op`)
-- Stringi lõpuni parseldamine
just :: Parser a -> Parser a
just p = filter (null . snd) . p
-- Determineeritud parserid
first :: Parser a -> Parser a
first p cs = [head r | not (null r)]
where r = p cs
-- Determineeritud iteratsioon
greedy = first . many
greedy1 = first . many1
-- Determineeritud valik
compulsion = first . optp
--------------------
--Lihtsaid parsereid
--------------------
-- Identifikaatorid
ident :: Parser String
ident = satp isAlpha <:*> greedy (satp isAlphaNum)
-- Naturaalarvud
natural :: Parser Int
natural = greedy1 digit
<@ foldl1 (\a b -> 10*a + b)
digit :: Parser Int
digit = satp isDigit <@ \x -> ord x - ord '0'
-- Täisarvud
integer :: Parser Int
integer = optp (symp '-') <*> natural <@ f
where f ([],n) = n
f (_ ,n) = -n
-- Reaalarvud
float :: Parser Float
float = (integer <@ fromIntegral)
<*> (symp '.' *> fract <|> succp 0)
<@ uncurry (+)
fract :: Parser Float
fract = greedy1 digit <@ foldr op 0
where d `op` x = (x + fromIntegral d)/10
-- Tühisümbolite eemaldamine
sp :: Parser a -> Parser a
sp = (greedy (satp isSpace) *>)
spsym :: Char -> Parser Char
spsym = sp . symp
sptok :: String -> Parser String
sptok = sp . tokp
spident :: Parser String
spident = sp ident
spint :: Parser Int
spint = sp integer
-- Sulud
paren p = pack (spsym '(') p (spsym ')')
brack p = pack (spsym '[') p (spsym ']')
block p = pack (sptok "begin") p (sptok "end")
-- Eraldajatega jadad
commaList p = listp p (symp ',')
semicList p = listp p (symp ';')