module Text.GrammarCombinators.Parser.RecursiveDescent (
parseRecDec
) where
import Text.GrammarCombinators.Base
import Text.GrammarCombinators.Transform.UnfoldRecursion
import Control.Monad.State
import Control.Monad.Maybe
import Data.Maybe
newtype RecDecRule t v = RecDecRule { runRD :: MaybeT (State [ConcreteToken t]) v } deriving (Monad)
instance MonadPlus (RecDecRule t) where
mzero = RecDecRule $ fail "mzero"
ma `mplus` mb =
RecDecRule $ MaybeT $ do olds <- get
result <- runMaybeT $ runRD ma
if isNothing result
then put olds >> runMaybeT (runRD mb)
else return result
instance ProductionRule (RecDecRule t) where
(>>>) = liftM2 ($)
(|||) = mplus
die = mzero
endOfInput = RecDecRule $ do [] <- get; return ()
instance EpsProductionRule (RecDecRule t) where
epsilon = return
instance LiftableProductionRule (RecDecRule t) where
epsilonL v _ = return v
instance (Token t) => TokenProductionRule (RecDecRule t) t where
token c =
do cr <- anyToken
if c == classify cr
then return cr
else fail $ "unexpected token " ++ show c ++ ", expecting " ++ show cr
anyToken = RecDecRule $ do (c':r) <- get
put r
return c'
parseRecDecBase :: RecDecRule t a -> [ConcreteToken t] -> Maybe a
parseRecDecBase parser s =
case flip runState s $ runMaybeT $ runRD parser of
(v,[]) -> v
_ -> error "No full parse"
parseRecDec :: forall phi t r ix. (Token t) =>
ProcessingContextFreeGrammar phi t r -> phi ix -> [ConcreteToken t] -> Maybe (r ix)
parseRecDec gram =
let
rpwgram :: phi ix -> RecDecRule t (r ix)
rpwgram = unfoldRecursion gram
in parseRecDecBase . rpwgram