EnumerateGrammar.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 FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Text.GrammarCombinators.Utils.EnumerateGrammar where

import Text.GrammarCombinators.Base
import Text.GrammarCombinators.Transform.FoldLoops

import Data.Enumerable (enumerate)

type EnumerateParserInternalGrammar phi t = forall ix . phi ix -> Int -> [[ConcreteToken t]]

newtype EnumerateProductionRule phi ixT r t v = IPP {
  printIPP :: EnumerateParserInternalGrammar phi t -> Int -> [[ConcreteToken t]]
  }

instance ProductionRule (EnumerateProductionRule phi ixT r t) where
  endOfInput = IPP $ \_ _ -> [[]]
  die = IPP $ \_ _ -> []
  a ||| b = IPP $ \g d -> printIPP a g d ++ printIPP b g d
  a >>> b = IPP $ \g d -> do x <- printIPP a g d
                             y <- printIPP b g d
                             return $ x ++ y

instance LiftableProductionRule (EnumerateProductionRule phi ixT r t) where
  epsilonL v _ = epsilon v

instance EpsProductionRule (EnumerateProductionRule phi ixT r t) where
  epsilon _ = IPP $ \_ _ -> [[]]

instance (Token t) => TokenProductionRule (EnumerateProductionRule phi ixT r t) t where
  token t = IPP $ \_ _ -> map (:[]) $ enumConcreteTokens t
  anyToken = IPP $ \_ _ -> [ enumConcreteTokens t | t <- enumerate :: [t] ]
                              

instance RecProductionRule (EnumerateProductionRule phi ixT r t) phi r where
  ref idx = IPP $ \g d -> if d > 0 then g idx $ d-1 else []

type EnumerateGrammar phi ixT (r :: * -> *) t rr = forall ix. phi ix -> EnumerateProductionRule phi ixT r t (rr ix)

enumerateGrammar :: forall phi r t rr ix. (Token t, FoldFam phi, ShowFam phi) =>
                    GContextFreeGrammar phi t r rr -> Int -> phi ix -> [[ConcreteToken t]]
enumerateGrammar gram depth idx =
  let
    igram :: EnumerateGrammar phi ixT r t rr 
    igram = gram
    intgram :: EnumerateParserInternalGrammar phi t
    intgram idx' = printIPP (igram idx') intgram
  in intgram idx depth
    
enumerateGrammarE ::
  forall phi r t rr ix. (Token t, FoldFam phi, ShowFam phi) =>
  GExtendedContextFreeGrammar phi t r rr -> Int -> phi ix -> [[ConcreteToken t]]
enumerateGrammarE gram depth idx =
  enumerateGrammar (foldLoops gram) depth (FLBase idx)