Processor.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 FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}

module Text.GrammarCombinators.Base.Processor ( 
  GProcessor,
  Processor,
  identityProcessor,
  trivialProcessor,
  applyProcessor',
  applyProcessor,
  applyProcessorL,
  applyProcessorLE,
  applyProcessorE
  ) where

import Text.GrammarCombinators.Base.Grammar
import Text.GrammarCombinators.Base.Domain
import Text.GrammarCombinators.Base.MultiRec
import Text.GrammarCombinators.Base.ProductionRule

import Language.Haskell.TH.Syntax (Q, Exp)

type GProcessor phi r rr = forall ix. phi ix -> rr ix -> r ix
type Processor phi r = GProcessor phi r (PF phi r)

-- | A trivial identity processor that keeps current production
-- rule results unmodified.
identityProcessor :: GProcessor phi r r
identityProcessor _ v = v

applyProcessor' ::
  (ProductionRule p, EpsProductionRule p) =>
  (forall ix . phi ix -> p (r ix)) ->
  GProcessor phi r' r -> 
  (forall ix . phi ix -> p (r' ix))
applyProcessor' grammar proc idx =
  proc idx $>> grammar idx 

-- | Apply a given processor to a given context-free grammar.
applyProcessor ::
  GContextFreeGrammar phi t r rr ->
  GProcessor phi rr' rr ->
  GContextFreeGrammar phi t r rr'
applyProcessor gram proc idx = applyProcessor' gram proc idx

applyProcessorL ::
  (LiftFam phi) =>
  GLContextFreeGrammar phi t r rr ->
  GProcessor phi rr' rr ->
  Q Exp -> 
  GLContextFreeGrammar phi t r rr'
applyProcessorL gram proc q idx = (proc idx, [| $(q) $(return $ liftIdxE idx) |]) $|>> gram idx

-- | Apply a given processor to a given extended context-free
-- grammar.
applyProcessorE ::
  GExtendedContextFreeGrammar phi t r rr ->
  GProcessor phi rr' rr ->
  GExtendedContextFreeGrammar phi t r rr'
applyProcessorE gram proc idx = applyProcessor' gram proc idx

-- | Apply a given processor to a given extended liftable context-free
-- grammar.
applyProcessorLE ::
  (LiftFam phi) =>
  GLExtendedContextFreeGrammar phi t r rr ->
  GProcessor phi rr' rr ->
  Q Exp ->
  GLExtendedContextFreeGrammar phi t r rr'
applyProcessorLE gram proc q idx = (proc idx, [| $(q) $(return $ liftIdxE idx) |]) $|>> gram idx

-- | A trivial processor that throws everything away and returns 
-- a value of the type K0 ().
trivialProcessor :: Processor phi (K0 ())
trivialProcessor _ _ = K0 ()