TopDown.hs

{-  Copyright 2010 Dominique Devriese

    This file is part of the grammar-combinators library.

    The grammar-combinators library is free software: you can
    redistribute it and/or modify it under the terms of the GNU
    Lesser General Public License as published by the Free
    Software Foundation, either version 3 of the License, or (at
    your option) any later version.

    Foobar is distributed in the hope that it will be useful, but
    WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
    GNU Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General
    Public License along with Foobar. If not, see
    <http://www.gnu.org/licenses/>.
-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | This was intended as a common library for top-down parser algorithms, but it 
-- is a bit outdated and currently only used by the LL1 parser.
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