Expression parser example from section 8.8 of Programming in Haskell, Graham Hutton, Cambridge University Press, 2007. Parser for simple arithmetic expressions ---------------------------------------- > import Parsing > import Control.Monad > > expr :: Parser Int > expr = do t <- term > do symbol "+" > e <- expr > return (t+e) > +++ return t > > term :: Parser Int > term = do f <- factor > do symbol "*" > t <- term > return (f * t) > +++ return f > > factor :: Parser Int > factor = do symbol "(" > e <- expr > symbol ")" > return e > +++ natural > > pare :: Parser a -> String -> a > pare p xs = case (parse p xs) of > [(n,[])] -> n > [(_,out)] -> error ("unused input " ++ out) > [] -> error "invalid input" > eval = pare expr --------------- Added by Fritz: --------------- Note that the original definition of eval above was generalized to include a parser argument, using "expr" for Hutton's eval. Then we can provide an alternate target type in terms of algebraic terms; we also include their syntax (infx) and semantics (evalg): semantics: > data Expr a = Lit a | Bop Opr (Expr a) (Expr a) deriving Show > data Opr = Add | Mul deriving Show > syn Add = "+" ; syn Mul = "*" > sem Add = (+) ; sem Mul = (*) > fold f g (Lit n) = f n > fold f g (Bop o l r) = g o (fold f g l) (fold f g r) > infx exp = fold show (inpar . syn) exp > where inpar o l r = concat ["(",l,o,r,")"] > evalg :: Expr Int -> Int > evalg = fold id sem ------------------ Now we can re-write the parsers above to generate general algebraic terms: that way we can do other things with the terms besides evaluating them. > popr o i s c = do { x<-i; do { symbol s; y<-o; return (Bop c x y) } +++ return x } > brak l e r a = do { symbol l; x <- e; symbol r; return x } +++ a > expr' = popr expr' term' "+" Add > term' = popr term' fact' "*" Mul > fact' = brak "(" expr' ")" (liftM Lit natural) > tree :: String -> Expr Int > tree = pare expr' > full = infx . tree ---------------------- Here's a quick attempt to generalie the above, so that we might easily generate parsers for other kinds of terms: > layer u [] = u > layer u ((s,c) : xs) = let e = popr e (layer u xs) s c in e > algebra ops l r atom = let e = layer f ops > f = brak l e r (liftM Lit atom) > in e > tree' :: String -> Expr Int > tree' = pare (algebra [("+", Add), ("*", Mul)] "(" ")" natural) >