module Text.GrammarCombinators.Transform.CombineGrammars (
combineGrammars
) where
import Text.GrammarCombinators.Base
newtype CGW p (phiL :: * -> *) (phiR :: * -> *) (rL :: * -> *) (rR :: * -> *) t v = MkCGW { unCGW :: p v }
instance (EpsProductionRule p, ProductionRule p,
RecProductionRule p (MergeDomain phiL phiR) (EitherFunctor rL rR)) =>
RecProductionRule (CGW p phiL phiR rL rR t) phiL rL where
ref idx = MkCGW $ unLeftR $>> ref (LeftIdx idx)
instance (EpsProductionRule p, ProductionRule p,
LoopProductionRule p (MergeDomain phiL phiR) (EitherFunctor rL rR)) =>
LoopProductionRule (CGW p phiL phiR rL rR t) phiL rL where
manyRef idx = MkCGW $ map unLeftR $>> manyRef (LeftIdx idx)
instance (EpsProductionRule p, ProductionRule p,
RecProductionRule p (MergeDomain phiL phiR) (EitherFunctor rL rR)) =>
ProductionRuleWithLibrary (CGW p phiL phiR rL rR t) phiR rR where
lib idx = MkCGW $ unRightR $>> ref (RightIdx idx)
instance (ProductionRule p) =>
ProductionRule (CGW p phiL phiR rL rR t) where
(MkCGW pl) >>> (MkCGW pr) = MkCGW (pl >>> pr)
(MkCGW pl) ||| (MkCGW pr) = MkCGW (pl ||| pr)
endOfInput = MkCGW endOfInput
die = MkCGW die
instance (LiftableProductionRule p) =>
LiftableProductionRule (CGW p phiL phiR rL rR t) where
epsilonL q v = MkCGW (epsilonL q v)
instance (EpsProductionRule p) =>
EpsProductionRule (CGW p phiL phiR rL rR t) where
epsilon v = MkCGW (epsilon v)
instance (TokenProductionRule p t) =>
TokenProductionRule (CGW p phiL phiR rL rR t) t where
token tt = MkCGW (token tt)
anyToken = MkCGW anyToken
newtype IGW p (phiL :: * -> *) (phiR :: * -> *) (rL :: * -> *) (rR :: * -> *) t v =
IGW { unIGW :: p v }
instance (EpsProductionRule p) => EpsProductionRule (IGW p phiL phiR rL rR t) where
epsilon v = IGW $ epsilon v
instance (LiftableProductionRule p) => LiftableProductionRule (IGW p phiL phiR rL rR t) where
epsilonL q v = IGW $ epsilonL q v
instance (TokenProductionRule p t) => TokenProductionRule (IGW p phiL phiR rL rR t) t where
token tt = IGW $ token tt
anyToken = IGW anyToken
instance (ProductionRule p) => ProductionRule (IGW p phiL phiR rL rR t) where
(IGW pl) >>> (IGW pr) = IGW (pl >>> pr)
(IGW pl) ||| (IGW pr) = IGW (pl ||| pr)
endOfInput = IGW endOfInput
die = IGW die
instance (EpsProductionRule p, ProductionRule p, RecProductionRule p (MergeDomain phiL phiR) (EitherFunctor rL rR)) =>
RecProductionRule (IGW p phiL phiR rL rR t) (MergeDomain phiR phiL) (EitherFunctor rR rL) where
ref (LeftIdx idx) = IGW $ (LeftR $>> (unRightR $>> ref (RightIdx idx)))
ref (RightIdx idx) = IGW $ (RightR $>> (unLeftR $>> ref (LeftIdx idx)))
instance (EpsProductionRule p, ProductionRule p, LoopProductionRule p (MergeDomain phiL phiR) (EitherFunctor rL rR)) =>
LoopProductionRule (IGW p phiL phiR rL rR t) (MergeDomain phiR phiL) (EitherFunctor rR rL) where
manyRef (LeftIdx idx) = IGW $ (map LeftR $>> (map unRightR $>> manyRef (RightIdx idx)))
manyRef (RightIdx idx) = IGW $ (map RightR $>> (map unLeftR $>> manyRef (LeftIdx idx)))
many1Ref (LeftIdx idx) = IGW $ (map LeftR $>> (map unRightR $>> many1Ref (RightIdx idx)))
many1Ref (RightIdx idx) = IGW $ (map RightR $>> (map unLeftR $>> many1Ref (LeftIdx idx)))
invertGrammar ::
(EpsProductionRule p, ProductionRule p) =>
(forall ix'. MergeDomain phiL phiR ix' -> p (EitherFunctor rL rR ix')) ->
MergeDomain phiR phiL ix -> p (EitherFunctor rR rL ix)
invertGrammar g (LeftIdx idx) = (LeftR . unRightR) $>> g (RightIdx idx)
invertGrammar g (RightIdx idx) = (RightR . unLeftR) $>> g (LeftIdx idx)
combineGrammars :: forall p phiL phiR rL rR rrL rrR t ix.
(EpsProductionRule p, ProductionRule p, TokenProductionRule p t,
RecProductionRule p (MergeDomain phiL phiR) (EitherFunctor rL rR),
LoopProductionRule p (MergeDomain phiL phiR) (EitherFunctor rL rR)) =>
(forall p' ix'. (ProductionRule p', EpsProductionRule p', TokenProductionRule p' t,
RecProductionRule p' phiL rL,
LoopProductionRule p' phiL rL,
ProductionRuleWithLibrary p' phiR rR) => phiL ix' -> p' (rrL ix')) ->
(forall p' ix'. (ProductionRule p', EpsProductionRule p', TokenProductionRule p' t,
RecProductionRule p' phiR rR,
LoopProductionRule p' phiR rR,
ProductionRuleWithLibrary p' phiL rL) => phiR ix' -> p' (rrR ix')) ->
MergeDomain phiL phiR ix -> p (EitherFunctor rrL rrR ix)
combineGrammars gL _ (LeftIdx idx) = LeftR $>> unCGW (gL idx)
combineGrammars gL gR (RightIdx idx) = unIGW (invertGrammar (combineGrammars gR gL) (RightIdx idx))