recursive_descent_parser.hs

{-# LANGUAGE FlexibleContexts #-}
{- Construct recursive descent parsers for the following grammars -}
import Text.Parsec

(<||>) :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
p <||> q = try p <|> q

{- S -> + S S | - S S | a -}
data G1 = P1G1 G1 G1 | P2G1 G1 G1 | T1G1 deriving (Eq, Show)
g1 :: Stream s m Char => ParsecT s u m G1
g1 = (char 'a' >> return T1G1) 
  <||> do op <- (char '+' >> return P1G1) <||> (char '-' >> return P1G1)
          e1 <- g1
          e2 <- g1
          return $ op e1 e2

{- S -> S ( S ) S | \epsilon 
- TODO does not construct parse tree, only accepts/rejects
-}
data G2 = P1G2 G2 G2 G2 | T1G2 deriving (Eq, Show)
g2 :: Stream s m Char => ParsecT s u m ()
g2 = g >> eof where
  f = between (char '(') (char ')') g
  g = many f >> return ()


{- S -> 0 S 1 | 0 1 -}
data G3 = P1G3 G3 | T1G3 deriving (Eq,Show)
g3 :: Stream s m Char => ParsecT s G3 m G3
g3 = f >> eof >> getState where
  g = (f >> modifyState P1G3) <||> (string "" >> modifyState id)
  f = between (char '0') (char '1') g