module Text.GrammarCombinators.Transform.UnfoldLoops (
unfoldLoops,
unfoldLoopsP,
unfoldLoopsRule,
replaceLoopsRule
) where
import Text.GrammarCombinators.Base
newtype UnfoldLoopsWrapper p (phi :: * -> *) ixT (r :: * -> *) t v = ULW {
runULW :: (forall ix. phi ix -> p [r ix]) -> (forall ix. phi ix -> p [r ix]) -> p v
}
instance (ProductionRule p) =>
ProductionRule (UnfoldLoopsWrapper p phi ixT r t) where
ra >>> rb = ULW $ \gm gm1 -> runULW ra gm gm1 >>> runULW rb gm gm1
ra ||| rb = ULW $ \gm gm1 -> runULW ra gm gm1 ||| runULW rb gm gm1
die = ULW $ \_ _ -> die
endOfInput = ULW $ \_ _ -> endOfInput
instance (LiftableProductionRule p) =>
LiftableProductionRule (UnfoldLoopsWrapper p phi ixT r t) where
epsilonL v q = ULW $ \_ _ -> epsilonL v q
instance (EpsProductionRule p) =>
EpsProductionRule (UnfoldLoopsWrapper p phi ixT r t) where
epsilon v = ULW $ \_ _ -> epsilon v
instance (TokenProductionRule p t) =>
TokenProductionRule (UnfoldLoopsWrapper p phi ixT r t) t where
token t = ULW $ \_ _ -> token t
anyToken = ULW $ \_ _ -> anyToken
instance (PenaltyProductionRule p) =>
PenaltyProductionRule (UnfoldLoopsWrapper p phi ixT r t) where
penalty p r = ULW $ \gm gm1 -> penalty p $ runULW r gm gm1
instance (RecProductionRule p phi r) =>
RecProductionRule (UnfoldLoopsWrapper p phi ixT r t) phi r where
ref idx = ULW $ \_ _ -> ref idx
instance (ProductionRule p, LiftableProductionRule p, RecProductionRule p phi r) =>
LoopProductionRule (UnfoldLoopsWrapper p phi ixT r t) phi r where
manyRef idx = ULW $ \gm _ -> gm idx
many1Ref idx = ULW $ \_ gm1 -> gm1 idx
unfoldLoops ::
GExtendedContextFreeGrammar phi t r rr ->
GContextFreeGrammar phi t r rr
unfoldLoops gram idx =
unfoldLoopsRule (gram idx)
unfoldLoopsP ::
GPenaltyExtendedContextFreeGrammar phi t r rr ->
GPenaltyContextFreeGrammar phi t r rr
unfoldLoopsP gram idx =
unfoldLoopsRuleP (gram idx)
unfoldLoopsRule ::
ExtendedContextFreeRule phi r t v ->
ContextFreeRule phi r t v
unfoldLoopsRule r =
let
manyGram idx = manyInf $ ref idx
oneOrMoreGram idx = (:) $>> ref idx >>> manyGram idx
in replaceLoopsRule r manyGram oneOrMoreGram
unfoldLoopsRuleP ::
PenaltyExtendedContextFreeRule phi r t v ->
PenaltyContextFreeRule phi r t v
unfoldLoopsRuleP r =
let manyGram idx = manyInf $ ref idx
oneOrMoreGram idx = (:) $>> ref idx >>> manyGram idx
in replaceLoopsRuleP r manyGram oneOrMoreGram
replaceLoopsRule ::
(ProductionRule p, EpsProductionRule p, RecProductionRule p phi r, TokenProductionRule p t) =>
ExtendedContextFreeRule phi r t v ->
(forall ix. phi ix -> p [r ix]) ->
(forall ix. phi ix -> p [r ix]) ->
p v
replaceLoopsRule r =
runULW r
replaceLoopsRuleP ::
(ProductionRule p, EpsProductionRule p, RecProductionRule p phi r, TokenProductionRule p t, PenaltyProductionRule p) =>
PenaltyExtendedContextFreeRule phi r t v ->
(forall ix. phi ix -> p [r ix]) ->
(forall ix. phi ix -> p [r ix]) ->
p v
replaceLoopsRuleP r = runULW r