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
-- code essentially from G Hutton's book, Chapter 9 -- cf also G Hutton, E Meijer, Monadic parser combinators, -- J Funct Prog, v 8, n 4, pp 437-444, 1998 -- parser datatype (the constructor Parser is there only for formal reasons) data Parser a = Parser (String -> [(a, String)]) -- parsing parse :: Parser a -> String -> [(a, String)] parse (Parser p) instring = p instring -- three basic parsers -- we declare Parser to be an instance of class Monad -- to get access to the special do syntax {- class Monad m where return :: a -> m a (>>=) :: m a -> (a -> m b) -> m b -} instance Monad Parser where return v = Parser (\ instring -> [(v, instring)]) p >>= f = Parser (\ instring -> case parse p instring of [] -> [] [(v, outstring)] -> parse (f v) outstring) {- -- follows from Parser being a Monad return :: a -> Parser a return v = Parser (\ instring -> [(v, instring)]) -} failure :: Parser a failure = Parser (\ instring -> []) item :: Parser Char item = Parser (\ instring -> case instring of [] -> [] (c : cs) -> [(c, cs)]) -- two basic parser combinators {- (>>=) :: Parser a -> (a -> Parser b) -> Parser b p >>= f = Parser( \ instring -> case parse p instring of [] -> [] [(v, outstring)] -> parse (f v) outstring ) -} twoitems :: Parser (Char, Char) {- twoitems = item >>= (\ c -> Parser (\ instring -> case instring of [] -> [] (c' : cs) -> [((c, c'), cs)])) -} {- twoitems = item >>= (\ c -> item >>= (\ c' -> return (c, c'))) -} twoitems = do c <- item c' <- item return (c, c') {- -- do syntax instead of p1 >>= \ v1 -> p2 >>= \ v2 -> ... pn >>= \ vn -> return (f v1 v2 ... vn) we may write do v1 <- p1 v2 <- p2 ... vn <- pn return (f v1 v2 ... vn) -} (+++) :: Parser a -> Parser a -> Parser a p +++ q = Parser (\ instring -> case parse p instring of [] -> parse q instring [(v, outstring)] -> [(v, outstring)]) -- some derived parsers -- recognizing different kinds of chars sat :: (Char -> Bool) -> Parser Char sat pred = do c <- item if pred c then return c else failure {- sat pred = Parser (\ instring -> case instring of [] -> [] (c : cs) -> if pred c then [(c, cs)] else []) -} digit :: Parser Char digit = sat isDigit lower :: Parser Char lower = sat isLower upper :: Parser Char upper = sat isUpper letter :: Parser Char letter = sat isAlpha alphanum :: Parser Char alphanum = sat isAlphaNum -- recognizing a specific char char :: Char -> Parser Char char c = sat (== c) -- recognizing a string string :: String -> Parser String string [] = return [] string (c : cs) = do char c string cs return (c : cs) -- parsing repetitions -- repetition zero, one or several times many :: Parser a -> Parser [a] many p = many1 p +++ return [] -- repetition one or several times many1 :: Parser a -> Parser [a] many1 p = do v <- p vs <- many p return (v : vs) {- many1 p = p >>= \ v -> many p >>= \ vs -> return (v : vs) -} ident :: Parser String ident = do c <- lower cs <- many alphanum return (c : cs) nat :: Parser Int nat = do cs <- many1 digit return (read cs) space :: Parser () space = do many (sat isSpace) return () -- tokens token :: Parser a -> Parser a token p = do space v <- p space return v identifier :: Parser String identifier = token ident natural :: Parser Int natural = token nat symbols :: String -> Parser String symbols cs = token (string cs) naturals1 :: Parser [Int] naturals1 = do symbols "[" n <- natural ns <- many (do symbols "," natural) symbols "]" return (n : ns) naturals :: Parser [Int] naturals = naturals1 +++ do symbols "[" symbols "]" return [] -- a simple grammar of expressions {- expr ::= nat | expr + expr | expr * expr * bind tighter than + +, * both associate to the right -} data Expr = Num Int | Expr :+ Expr | Expr:* Expr deriving Show {- expr ::= term + expr | term term ::= factor * term | factor factor ::= (expr) | nat nat ::= 0 | 1 | 2 | ... -} -- here is a parser for expressions {- expr :: Parser Expr expr = do t <- term do symbols "+" e <- expr return (t :+ e) +++ return t term :: Parser Expr term = do f <- factor do symbols "*" t <- term return (f :* t) +++ return f factor :: Parser Expr factor = do symbols "(" e <- expr symbols ")" return e +++ do n <- natural return (Num n) -} -- this parser not only parses but also evaluates expr :: Parser Int expr = do t <- term do symbols "+" e <- expr return (t + e) +++ return t term :: Parser Int term = do f <- factor do symbols "*" t <- term return (f * t) +++ return f factor :: Parser Int factor = do symbols "(" e <- expr symbols ")" return e +++ natural -- Exercise: try this for While {- type Var = String data AExpr = Var Var | Num Integer | AExpr :+ AExpr | AExpr :- AExpr | AExpr :* AExpr data BExpr = T | F | AExpr :== AExpr | AExpr :<= AExpr | Not BExpr | BExpr :&& BExpr | BExpr :|| BExpr data Stm = Var ::= AExpr | Skip | Stm :\ Stm | If BExpr Stm Stm | While BExpr Stm -}