{-  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 FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Text.GrammarCombinators.Base.Grammar  where

import Text.GrammarCombinators.Base.ProductionRule
import Text.GrammarCombinators.Base.MultiRec

type RegularRule phi r t v =
  forall p. (ProductionRule p, EpsProductionRule p, TokenProductionRule p t) =>
  p v

type PenaltyRegularRule phi r t v =
  forall p. (ProductionRule p, EpsProductionRule p, TokenProductionRule p t, PenaltyProductionRule p) =>
  p v

type BiasedRegularRule phi r t v =
  forall p. (ProductionRule p, EpsProductionRule p, TokenProductionRule p t, BiasedProductionRule p) =>
  p v

type ContextFreeRule phi r t v =
  forall p. (ProductionRule p, EpsProductionRule p, RecProductionRule p phi r, TokenProductionRule p t) =>
  p v

type PenaltyContextFreeRule phi r t v =
  forall p. (ProductionRule p, EpsProductionRule p, RecProductionRule p phi r, TokenProductionRule p t, PenaltyProductionRule p) =>
  p v

type BiasedContextFreeRule phi r t v =
  forall p. (ProductionRule p, EpsProductionRule p, RecProductionRule p phi r, TokenProductionRule p t, BiasedProductionRule p) =>
  p v

type ExtendedContextFreeRule phi r t v =
  forall p. (ProductionRule p, EpsProductionRule p, RecProductionRule p phi r, TokenProductionRule p t, LoopProductionRule p phi r) =>
  p v

type PenaltyExtendedContextFreeRule phi r t v =
  forall p. (ProductionRule p, EpsProductionRule p, RecProductionRule p phi r, TokenProductionRule p t, LoopProductionRule p phi r, PenaltyProductionRule p) =>
  p v

type BiasedExtendedContextFreeRule phi r t v =
  forall p. (ProductionRule p, EpsProductionRule p, RecProductionRule p phi r, TokenProductionRule p t, LoopProductionRule p phi r, BiasedProductionRule p) =>
  p v

type BiasedExtendedLiftableContextFreeRule phi r t v =
  forall p. (ProductionRule p, LiftableProductionRule p, RecProductionRule p phi r, TokenProductionRule p t, LoopProductionRule p phi r, BiasedProductionRule p) =>
  p v

type AnyExtendedContextFreeRule phi r t v =
  forall p. (ProductionRule p, EpsProductionRule p, RecProductionRule p phi r, TokenProductionRule p t, LoopProductionRule p phi r, PenaltyProductionRule p, BiasedProductionRule p) =>
  p v

type LAnyExtendedContextFreeRule phi r t v =
  forall p. (ProductionRule p, LiftableProductionRule p, RecProductionRule p phi r, TokenProductionRule p t, LoopProductionRule p phi r, PenaltyProductionRule p, BiasedProductionRule p) =>
  p v

type LiftableContextFreeRule phi r t v =
  forall p. (ProductionRule p, LiftableProductionRule p, RecProductionRule p phi r, TokenProductionRule p t) =>
  p v

type ExtendedLiftableContextFreeRule phi r t v =
  forall p. (ProductionRule p, LiftableProductionRule p, RecProductionRule p phi r, TokenProductionRule p t, LoopProductionRule p phi r) =>
  p v

type GGrammar rt phi t r rr = 
  forall ix. phi ix -> rt phi r t (rr ix)
type AGrammar rt phi t = forall r. GGrammar rt phi t r (PF phi r)
type PGrammar rt phi t r = GGrammar rt phi t r r

type GRegularGrammar phi t r rr = GGrammar RegularRule phi t r rr
type GContextFreeGrammar phi t r rr = GGrammar ContextFreeRule phi t r rr
type GLContextFreeGrammar phi t r rr = GGrammar LiftableContextFreeRule phi t r rr
type GPenaltyContextFreeGrammar phi t r rr = GGrammar PenaltyContextFreeRule phi t r rr
type GBiasedContextFreeGrammar phi t r rr = GGrammar BiasedContextFreeRule phi t r rr
type GExtendedContextFreeGrammar phi t r rr = GGrammar ExtendedContextFreeRule phi t r rr
type GPenaltyExtendedContextFreeGrammar phi t r rr = GGrammar PenaltyExtendedContextFreeRule phi t r rr
type GBiasedExtendedContextFreeGrammar phi t r rr = GGrammar BiasedExtendedContextFreeRule phi t r rr
type GAnyExtendedContextFreeGrammar phi t r rr = GGrammar AnyExtendedContextFreeRule phi t r rr
type GLAnyExtendedContextFreeGrammar phi t r rr = GGrammar LAnyExtendedContextFreeRule phi t r rr
type GLExtendedContextFreeGrammar phi t r rr = GGrammar ExtendedLiftableContextFreeRule phi t r rr

type ContextFreeGrammar phi t = AGrammar ContextFreeRule phi t
type LContextFreeGrammar phi t = AGrammar LiftableContextFreeRule phi t
type ExtendedContextFreeGrammar phi t = AGrammar ExtendedContextFreeRule phi t
type PenaltyExtendedContextFreeGrammar phi t r rr = AGrammar PenaltyExtendedContextFreeRule phi t 
type BiasedExtendedContextFreeGrammar phi t r rr = AGrammar BiasedExtendedContextFreeRule phi t 
type LExtendedContextFreeGrammar phi t = AGrammar ExtendedLiftableContextFreeRule phi t

type ProcessingRegularGrammar phi t r = PGrammar RegularRule phi t r
type ProcessingPenaltyRegularGrammar phi t r = PGrammar PenaltyRegularRule phi t r
type ProcessingBiasedRegularGrammar phi t r = PGrammar BiasedRegularRule phi t r
type ProcessingContextFreeGrammar phi t r = PGrammar ContextFreeRule phi t r
type ProcessingLContextFreeGrammar phi t r = PGrammar LiftableContextFreeRule phi t r
type ProcessingPenaltyContextFreeGrammar phi t r = PGrammar PenaltyContextFreeRule phi t r
type ProcessingBiasedContextFreeGrammar phi t r = PGrammar BiasedContextFreeRule phi t r
type ProcessingExtendedContextFreeGrammar phi t r = PGrammar ExtendedContextFreeRule phi t r
type ProcessingPenaltyExtendedContextFreeGrammar phi t r = PGrammar PenaltyExtendedContextFreeRule phi t r
type ProcessingBiasedExtendedContextFreeGrammar phi t r = PGrammar BiasedExtendedContextFreeRule phi t r
type ProcessingLExtendedContextFreeGrammar phi t r = PGrammar ExtendedLiftableContextFreeRule phi t r
type ProcessingLBiasedExtendedContextFreeGrammar phi t r = PGrammar BiasedExtendedLiftableContextFreeRule phi t r