module Text.GrammarCombinators.Transform.UnfoldChainNTs (
unfoldChainNTs,
unfoldChainNTsE
) where
import Text.GrammarCombinators.Base
import Text.GrammarCombinators.Utils.IsChainNT
import Text.GrammarCombinators.Transform.UnfoldRecursion
import Text.GrammarCombinators.Transform.UnfoldLoops
unfoldChainNTs :: forall phi r t. (EqFam phi) =>
ProcessingContextFreeGrammar phi r t ->
ProcessingContextFreeGrammar phi r t
unfoldChainNTs gram idx =
let
gram' :: ProcessingContextFreeGrammar phi r t
gram' idx' = if isChainNT (unfoldChainNTs gram) idx'
then unfoldChainNTs gram idx'
else ref idx'
in unfoldRule (gram idx) gram'
data RuleToManyWrapper p (phi :: * -> *) (r :: * -> *) t v =
RTMEps v |
RTMW { ruleToManyRule :: p [v],
ruleToMany1Rule :: p [v] }
instance (ProductionRule p, EpsProductionRule p) =>
ProductionRule (RuleToManyWrapper p phi r t) where
(RTMEps va) >>> (RTMEps vb) = RTMEps $ va vb
(RTMEps va) >>> (RTMW rmb rm1b) = RTMW (map va $>> rmb) (map va $>> rm1b)
(RTMW rma rm1a) >>> (RTMEps vb) = RTMW (map ($ vb) $>> rma) (map ($ vb) $>> rm1a)
(RTMW _ _ ) >>> (RTMW _ _) = RTMW die die
_ ||| _ = RTMW die die
die = RTMW die die
endOfInput = RTMW die die
instance (ProductionRule p, EpsProductionRule p) => EpsProductionRule (RuleToManyWrapper p phi r t) where
epsilon = RTMEps
instance (ProductionRule p, EpsProductionRule p) => LiftableProductionRule (RuleToManyWrapper p phi r t) where
epsilonL v _ = RTMEps v
instance (ProductionRule p) => TokenProductionRule (RuleToManyWrapper p phi r t) t where
token _ = RTMW die die
anyToken = RTMW die die
instance (LoopProductionRule p phi r) =>
RecProductionRule (RuleToManyWrapper p phi r t) phi r where
ref idx = RTMW (manyRef idx) (many1Ref idx)
instance (ProductionRule p, EpsProductionRule p, LoopProductionRule p phi r) =>
LoopProductionRule (RuleToManyWrapper p phi r t) phi r where
manyRef _ = RTMW die die
many1Ref _ = RTMW die die
unfoldChainNTsE :: forall phi r t. (EqFam phi) =>
ProcessingExtendedContextFreeGrammar phi r t ->
ProcessingExtendedContextFreeGrammar phi r t
unfoldChainNTsE gram idx =
let gramm' idx' = if isChainNT (unfoldChainNTsE gram) idx'
then ruleToManyRule (unfoldChainNTsE gram idx')
else manyRef idx'
gramm1' idx' = if isChainNT (unfoldChainNTsE gram) idx'
then ruleToMany1Rule (unfoldChainNTsE gram idx')
else many1Ref idx'
gram' :: ProcessingExtendedContextFreeGrammar phi r t
gram' idx' = if isChainNT (unfoldChainNTsE gram) idx'
then unfoldChainNTsE gram idx'
else ref idx'
in replaceLoopsRule (unfoldRuleE (gram idx) gram') gramm' gramm1'