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 Monad import Char infixr 4 <|> -- Parserite monaad newtype Parser a = P (String -> [(a,String)]) runP :: Parser a -> String -> [(a,String)] runP (P p) = p instance Monad Parser where return a = P $ \cs -> [(a,cs)] p >>= f = P $ \cs -> concat [runP (f a) cs' | (a,cs') <- runP p cs] instance MonadPlus Parser where mzero = P $ \cs -> [] mplus p q = P $ \cs -> runP p cs ++ runP q cs -- Primitiivparserid item :: Parser Char item = P $ \cs -> [(head cs, tail cs) | not (null cs)] first :: Parser a -> Parser a first p = P $ \cs -> case runP p cs of [] -> [] (x:xs) -> [x] -- Elementaarparserid sat :: (Char -> Bool) -> Parser Char sat p = do {c <- item; if p c then return c else mzero} (<|>) :: Parser a -> Parser a -> Parser a p <|> q = first (p `mplus` q) char :: Char -> Parser Char char c = sat (c ==) string :: String -> Parser String string "" = return "" string (c:cs) = do {char c; string cs; return (c:cs)} -- Iteratsioon many :: Parser a -> Parser [a] many p = many1 p <|> return [] many1 :: Parser a -> Parser [a] many1 p = do {a <- p; as <- many p; return (a:as)} -- Üldistatud sulud pack :: Parser a -> Parser b -> Parser c -> Parser b pack s1 p s2 = do {s1; x <- p; s2; return x} -- Eraldajatega jadad sepby :: Parser a -> Parser b -> Parser [a] p `sepby` sep = (p `sepby1` sep) <|> return [] sepby1 :: Parser a -> Parser b -> Parser [a] p `sepby1` sep = do {a <- p; as <- many (sep >> p); return (a:as)} chainl :: Parser a -> Parser (a->a->a) -> Parser a chainl p s = do x <- p ys <- many (do {op <- s; y <- p; return (op,y)}) return (foldl (\a (op,y) -> a `op` y) x ys) chainr :: Parser a -> Parser (a->a->a) -> Parser a chainr p s = do ys <- many (do {y <- p; op <- s; return (y,op)}) x <- p return (foldr (\(y,op) b -> y `op` b) x ys) -------------------- --Lihtsaid parsereid -------------------- -- Märgiklassid lower :: Parser Char lower = sat isLower upper :: Parser Char upper = sat isUpper letter :: Parser Char letter = sat isAlpha alphanum :: Parser Char alphanum = sat isAlphaNum -- Identifikaatorid identifier :: Parser String identifier = do {c <- lower; cs <- many alphanum; return (c:cs)} -- Naturaalarvud natural :: Parser Int natural = do {ds <- many1 digit; return (foldl1 (\a b -> 10*a + b) ds)} digit :: Parser Int digit = do {c <- sat isDigit; return (ord c - ord '0')} -- Täisarvud integer :: Parser Int integer = do {char '-'; n <- natural; return (-n)} <|> natural -- Reaalarvud floating :: Parser Float floating = do i <- integer f <- do {char '.'; fraction} <|> return 0 return (fromIntegral i + f) fraction :: Parser Float fraction = do {ds <- many1 digit; return (foldr op 0 ds)} where d `op` x = (x + fromIntegral d)/10 -- Tühisümbolite eemaldamine space :: Parser String space = many (sat isSpace) token :: Parser a -> Parser a token p = do {a <- p; space; return a} keyc :: Char -> Parser Char keyc c = token (char c) keyw :: String -> Parser String keyw cs = token (string cs) ident :: Parser String ident = token identifier nat :: Parser Int nat = token natural int :: Parser Int int = token integer float :: Parser Float float = token floating -- Sulud paren p = pack (keyc '(') p (keyc ')') brack p = pack (keyc '[') p (keyc ']') block p = pack (keyw "begin") p (keyw "end") -- Eraldajatega jadad commaList p = sepby p (keyw ",") semicList p = sepby p (keyw ";") -- Kogu sisendi parsimine parse :: Parser a -> String -> a parse p cs = case runP (first (space >> p)) cs of [(x,"")] -> x _ -> error "Parse error"