ExpParser1-leftrecur.hs

import Text.ParserCombinators.ReadP
import Control.Monad
import Data.Char

data Exp = Add Exp Exp
         | Mul Exp Exp
         | Num Int
         | Dbl Double
         | Neg Exp
         deriving (Show, Eq)

space :: ReadP Char
space = char ' '

spaces :: ReadP String
spaces = many space

token :: ReadP a -> ReadP a
token p = do
  res <- p
  spaces
  return res

symbol :: String -> ReadP String
symbol = token . string

num :: ReadP Int
num = token $ liftM read (many1 $ satisfy isDigit)

exp' :: ReadP Exp
exp' = do
  e <- exp1
  eof
  return e

{- For comparison:
chainl1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
chainl1 p op = p >>= \x -> rest x
  where rest x = do f <- op
                    y <- p
                    rest (f x y)
                 +++ return x
 -}

exp1 :: ReadP Exp
exp1 = do
  e  <- exp3
  e' <- exp1' e
  return e'

exp1' :: Exp -> ReadP Exp
exp1' e = do symbol "+"
             e' <- exp2
             exp1' (Add e e')
          +++ return e

exp2 :: ReadP Exp
exp2 = do eLeft <- exp3
          symbol "*"
          eRight <- exp2
          return (Mul eLeft eRight)
       +++
       do e <- exp3
          return e

exp3 :: ReadP Exp
exp3 = do n <- num
          return (Num n)
       +++
       do symbol "-"
          e <- exp1
          return (Neg e)
       +++
       do symbol "("
          e <- exp1
          symbol ")"
          return e

parse :: String -> Either String Exp
parse s =
  case readP_to_S exp' s of
    [(exp, "")] -> Right exp
    []          -> Left "Invalid"
    _           -> Left "Ambiguous"