module Text.GrammarCombinators.Parser.TopDown where
import Control.Monad.Maybe
import Control.Monad.State
import Text.GrammarCombinators.Base
newtype NonBranchingRule phi r t v = MkNBR {
unNBR :: (forall ix. phi ix -> [ConcreteToken t] -> NonBranchingRule phi r t (r ix)) -> MaybeT (State [ConcreteToken t]) v
}
instance Functor (NonBranchingRule phi r t) where
fmap f r = MkNBR $ \g -> fmap f $ unNBR r g
instance Monad (NonBranchingRule phi r t) where
ra >> rb = MkNBR $ \g -> unNBR ra g >> unNBR rb g
ra >>= f = MkNBR $ \g -> unNBR ra g >>= \v -> unNBR (f v) g
return v = MkNBR $ \_ -> return v
nbrEndOfInput :: NonBranchingRule phi r t ()
nbrEndOfInput = MkNBR $ \_ -> do [] <- get; return ()
type UnambiguousTopDownGrammar phi r t = (Domain phi, Token t) => phi ix -> [ConcreteToken t] -> NonBranchingRule phi r t (r ix)
newtype WrapLookaheadNBR phi r t ix = WrapLNBR {
unWrapLNBR :: [ConcreteToken t] -> NonBranchingRule phi r t (r ix)
}
parseTopDown :: forall phi r t ix. (Domain phi, Token t) => UnambiguousTopDownGrammar phi r t -> phi ix -> [ConcreteToken t] -> Maybe (r ix)
parseTopDown gram idx s =
let
memoGram :: UnambiguousTopDownGrammar phi r t
memoGram = unWrapLNBR . memoFamily (WrapLNBR . gram)
currule :: NonBranchingRule phi r t (r ix)
currule = memoGram idx s
exec :: State [ConcreteToken t] (Maybe (r ix))
exec = runMaybeT $ unNBR currule gram
in evalState exec s