module Text.GrammarCombinators.Transform.UnfoldRecursion (
UnfoldDepth,
unfoldRecursion,
unfoldRecursionP,
unfoldRecursionB,
unfoldRecursionE,
selectNothing,
selectAllOnce,
selectNT,
unselectNT,
sumUD,
scaleUD,
modifyUnfoldDepth,
unfoldSelective,
unfoldSelectiveE,
unfoldRule,
unfoldRuleE
) where
import Text.GrammarCombinators.Base
import Text.GrammarCombinators.Transform.UnfoldLoops
data RPWRule p phi ixT r t v =
RPWRule { unRPWRule :: (forall ix. phi ix -> p (r ix)) -> p v }
instance (ProductionRule p) =>
ProductionRule (RPWRule p phi ixT r t) where
a >>> b = RPWRule $ \g -> unRPWRule a g >>> unRPWRule b g
a ||| b = RPWRule $ \g -> unRPWRule a g ||| unRPWRule b g
die = RPWRule $ const die
endOfInput = RPWRule $ const endOfInput
instance (LiftableProductionRule p) =>
LiftableProductionRule (RPWRule p phi ixT r t) where
epsilonL v q = RPWRule $ \_ -> epsilonL v q
instance (PenaltyProductionRule p) =>
PenaltyProductionRule (RPWRule p phi ixT r t) where
penalty p r = RPWRule $ \g -> penalty p $ unRPWRule r g
instance (BiasedProductionRule p) =>
BiasedProductionRule (RPWRule p phi ixT r t) where
a >||| b = RPWRule $ \g -> unRPWRule a g >||| unRPWRule b g
a <||| b = RPWRule $ \g -> unRPWRule a g <||| unRPWRule b g
instance (EpsProductionRule p) =>
EpsProductionRule (RPWRule p phi ixT r t) where
epsilon v = RPWRule $ \_ -> epsilon v
instance (TokenProductionRule p t) =>
TokenProductionRule (RPWRule p phi ixT r t) t where
token c = RPWRule $ \_ -> token c
anyToken = RPWRule $ \_ -> anyToken
instance (ProductionRule p) =>
RecProductionRule (RPWRule p phi ixT r t) phi r where
ref idx = RPWRule $ \g -> g idx
instance (LoopProductionRule p phi r) =>
LoopProductionRule (RPWRule p phi ixT r t) phi r where
manyRef idx = RPWRule $ \_ -> manyRef idx
many1Ref idx = RPWRule $ \_ -> many1Ref idx
unfoldRecursion ::
ProcessingContextFreeGrammar phi t r ->
ProcessingRegularGrammar phi t r
unfoldRecursion gram idx =
unRPWRule (gram idx) $ unfoldRecursion gram
unfoldRecursionP ::
ProcessingPenaltyContextFreeGrammar phi t r ->
ProcessingPenaltyRegularGrammar phi t r
unfoldRecursionP gram idx =
unRPWRule (gram idx) $ unfoldRecursionP gram
unfoldRecursionB ::
ProcessingBiasedContextFreeGrammar phi t r ->
ProcessingBiasedRegularGrammar phi t r
unfoldRecursionB gram idx =
unRPWRule (gram idx) $ unfoldRecursionB gram
unfoldRecursionE ::
ProcessingExtendedContextFreeGrammar phi t r ->
ProcessingRegularGrammar phi t r
unfoldRecursionE gram = unfoldRecursion (unfoldLoops gram)
type UnfoldDepth phi = forall ix. phi ix -> Integer
selectNothing :: UnfoldDepth phi
selectNothing _ = 0
selectAllOnce :: UnfoldDepth phi
selectAllOnce _ = 1
sumUD :: UnfoldDepth phi -> UnfoldDepth phi -> UnfoldDepth phi
(da `sumUD` db) idx = da idx + db idx
scaleUD :: Integer -> UnfoldDepth phi -> UnfoldDepth phi
(r `scaleUD` d) idx = r * d idx
modifyUnfoldDepth :: (EqFam phi) => UnfoldDepth phi -> (Integer -> Integer) -> phi ix -> UnfoldDepth phi
modifyUnfoldDepth base f idx = overrideIdxK base idx $ f $ base idx
selectNT :: (EqFam phi) => UnfoldDepth phi -> phi ix -> UnfoldDepth phi
selectNT base = modifyUnfoldDepth base (+1)
unselectNT :: (EqFam phi) => UnfoldDepth phi -> phi ix -> UnfoldDepth phi
unselectNT base = modifyUnfoldDepth base (flip () 1)
type RPWGrammar p phi ixT r v t =
forall ix. phi ix -> RPWRule p phi ixT r t (v ix)
unfoldSelective' :: forall p phi ixT r t. (EqFam phi, RecProductionRule p phi r) =>
UnfoldDepth phi ->
RPWGrammar p phi ixT r r t ->
(forall ix. phi ix -> p (r ix))
unfoldSelective' sel gram idx =
let rg :: phi ix' -> p (r ix')
rg idx' = if sel idx' > 0
then unfoldSelective' (modifyUnfoldDepth sel (flip () 1) idx') gram idx'
else ref idx'
in unRPWRule (gram idx) rg
unfoldSelective :: (EqFam phi) =>
UnfoldDepth phi ->
ProcessingContextFreeGrammar phi t r ->
ProcessingContextFreeGrammar phi t r
unfoldSelective sel gram idx = unfoldSelective' sel gram idx
unfoldSelectiveE :: (EqFam phi) =>
UnfoldDepth phi ->
ProcessingExtendedContextFreeGrammar phi t r ->
ProcessingExtendedContextFreeGrammar phi t r
unfoldSelectiveE sel gram idx =
unfoldSelective' sel gram idx
unfoldRule :: ContextFreeRule phi r t v ->
ProcessingContextFreeGrammar phi t r ->
ContextFreeRule phi r t v
unfoldRule r g = unRPWRule r g
unfoldRuleE :: ExtendedContextFreeRule phi r t v ->
ProcessingExtendedContextFreeGrammar phi t r ->
ExtendedContextFreeRule phi r t v
unfoldRuleE r g = unRPWRule r g