module Language.Parser.Ptera.Pipeline.PEG2LAPEG where

import           Language.Parser.Ptera.Prelude

import qualified Data.EnumMap.Strict                         as EnumMap
import qualified Language.Parser.Ptera.Data.Alignable.Array  as AlignableArray
import qualified Language.Parser.Ptera.Data.Alignable.Map    as AlignableMap
import qualified Language.Parser.Ptera.Data.Alignable.Set    as AlignableSet
import qualified Language.Parser.Ptera.Data.Symbolic.IntSet  as SymbolicIntSet
import qualified Language.Parser.Ptera.Machine.LAPEG         as LAPEG
import qualified Language.Parser.Ptera.Machine.LAPEG.Builder as LAPEGBuilder
import qualified Language.Parser.Ptera.Machine.PEG           as PEG


peg2LaPeg :: Enum start
    => PEG.T start varDoc altDoc a
    -> Except (AlignableSet.T PEG.VarNum) (LAPEG.T start varDoc altDoc a)
peg2LaPeg :: T start varDoc altDoc a
-> Except (T VarNum) (T start varDoc altDoc a)
peg2LaPeg T start varDoc altDoc a
g = BuilderT start varDoc altDoc a (ExceptT (T VarNum) Identity) ()
-> Except (T VarNum) (T start varDoc altDoc a)
forall (m :: * -> *) start varDoc altDoc a.
Monad m =>
BuilderT start varDoc altDoc a m () -> m (T start varDoc altDoc a)
LAPEGBuilder.build BuilderT start varDoc altDoc a (ExceptT (T VarNum) Identity) ()
builder where
    builder :: BuilderT start varDoc altDoc a (ExceptT (T VarNum) Identity) ()
builder = do
        Context start varDoc altDoc a
initialCtxBuilder <- StateT
  (Context start varDoc altDoc a)
  (ExceptT (T VarNum) Identity)
  (Context start varDoc altDoc a)
forall (m :: * -> *) s. Monad m => StateT s m s
get
        let initialCtx :: Context start varDoc altDoc a
initialCtx = Context :: forall start varDoc altDoc a.
Context start varDoc altDoc a
-> T VarNum VarNum
-> T VarNum (Maybe HeadRange)
-> [(VarNum, HeadRange, [Alt altDoc a])]
-> T VarNum (Var varDoc)
-> T VarNum Rule
-> T AltNum (Alt altDoc a)
-> Context start varDoc altDoc a
Context
                { $sel:ctxBuilder:Context :: Context start varDoc altDoc a
ctxBuilder = Context start varDoc altDoc a
initialCtxBuilder
                , $sel:ctxVarMap:Context :: T VarNum VarNum
ctxVarMap = T VarNum VarNum
forall k (n :: k) a. Map n a
AlignableMap.empty
                , $sel:ctxAvailableRuleRanges:Context :: T VarNum (Maybe HeadRange)
ctxAvailableRuleRanges = T VarNum (Maybe HeadRange)
forall k (n :: k) a. Map n a
AlignableMap.empty
                , $sel:ctxUpdateRuleStack:Context :: [(VarNum, HeadRange, [Alt altDoc a])]
ctxUpdateRuleStack = []
                , $sel:ctxOriginalVars:Context :: T VarNum (Var varDoc)
ctxOriginalVars = T start varDoc altDoc a -> T VarNum (Var varDoc)
forall start varDoc altDoc a.
PEG start varDoc altDoc a -> T VarNum (Var varDoc)
PEG.vars T start varDoc altDoc a
g
                , $sel:ctxOriginalRules:Context :: T VarNum Rule
ctxOriginalRules = T start varDoc altDoc a -> T VarNum Rule
forall start varDoc altDoc a.
PEG start varDoc altDoc a -> T VarNum Rule
PEG.rules T start varDoc altDoc a
g
                , $sel:ctxOriginalAlts:Context :: T AltNum (Alt altDoc a)
ctxOriginalAlts = T start varDoc altDoc a -> T AltNum (Alt altDoc a)
forall start varDoc altDoc a.
PEG start varDoc altDoc a -> T AltNum (Alt altDoc a)
PEG.alts T start varDoc altDoc a
g
                }
        let (Either (T VarNum) ()
mx, Context start varDoc altDoc a
finalCtx) = State (Context start varDoc altDoc a) (Either (T VarNum) ())
-> Context start varDoc altDoc a
-> (Either (T VarNum) (), Context start varDoc altDoc a)
forall s a. State s a -> s -> (a, s)
runState
                do ExceptT (T VarNum) (State (Context start varDoc altDoc a)) ()
-> State (Context start varDoc altDoc a) (Either (T VarNum) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do EnumMap start VarNum
-> ExceptT (T VarNum) (State (Context start varDoc altDoc a)) ()
forall start varDoc altDoc a.
Enum start =>
EnumMap start VarNum
-> ExceptT (T VarNum) (State (Context start varDoc altDoc a)) ()
pipeline do T start varDoc altDoc a -> EnumMap start VarNum
forall start varDoc altDoc a.
PEG start varDoc altDoc a -> EnumMap start VarNum
PEG.initials T start varDoc altDoc a
g
                do Context start varDoc altDoc a
initialCtx
        case Either (T VarNum) ()
mx of
            Left T VarNum
vs -> ExceptT (T VarNum) Identity ()
-> BuilderT start varDoc altDoc a (ExceptT (T VarNum) Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do T VarNum -> ExceptT (T VarNum) Identity ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE T VarNum
vs
            Right{} -> Context start varDoc altDoc a
-> BuilderT start varDoc altDoc a (ExceptT (T VarNum) Identity) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do Context start varDoc altDoc a -> Context start varDoc altDoc a
forall start varDoc altDoc a.
Context start varDoc altDoc a -> Context start varDoc altDoc a
ctxBuilder Context start varDoc altDoc a
finalCtx

    pipeline :: EnumMap start VarNum
-> ExceptT (T VarNum) (State (Context start varDoc altDoc a)) ()
pipeline EnumMap start VarNum
inits = do
        T VarNum
rvs <- (T VarNum
 -> (start, VarNum)
 -> ExceptT
      (T VarNum) (State (Context start varDoc altDoc a)) (T VarNum))
-> T VarNum
-> [(start, VarNum)]
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) (T VarNum)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM
            do \T VarNum
vs1 (start
s, VarNum
v) -> ExceptT
  (T VarNum) (State (Context start varDoc altDoc a)) (T VarNum)
-> (T VarNum
    -> ExceptT
         (T VarNum) (State (Context start varDoc altDoc a)) (T VarNum))
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) (T VarNum)
forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
catchE
                do
                    start
-> VarNum
-> ExceptT (T VarNum) (State (Context start varDoc altDoc a)) ()
forall start varDoc altDoc a.
Enum start =>
start -> VarNum -> Pipeline start varDoc altDoc a ()
pegInitialPipeline start
s VarNum
v
                    T VarNum
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) (T VarNum)
forall (f :: * -> *) a. Applicative f => a -> f a
pure T VarNum
vs1
                \T VarNum
vs2 -> do
                    StateT (Context start varDoc altDoc a) Identity ()
-> ExceptT (T VarNum) (State (Context start varDoc altDoc a)) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
                        (Context start varDoc altDoc a -> Context start varDoc altDoc a)
-> StateT (Context start varDoc altDoc a) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \Context start varDoc altDoc a
ctx -> Context start varDoc altDoc a
ctx
                            { $sel:ctxAvailableRuleRanges:Context :: T VarNum (Maybe HeadRange)
ctxAvailableRuleRanges = T VarNum (Maybe HeadRange)
forall k (n :: k) a. Map n a
AlignableMap.empty
                            , $sel:ctxUpdateRuleStack:Context :: [(VarNum, HeadRange, [Alt altDoc a])]
ctxUpdateRuleStack = []
                            }
                    T VarNum
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) (T VarNum)
forall (f :: * -> *) a. Applicative f => a -> f a
pure do T VarNum -> T VarNum -> T VarNum
forall k (n :: k). Set n -> Set n -> Set n
AlignableSet.union T VarNum
vs1 T VarNum
vs2
            do T VarNum
forall k (n :: k). Set n
AlignableSet.empty
            do EnumMap start VarNum -> [(start, VarNum)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EnumMap.assocs EnumMap start VarNum
inits
        if T VarNum -> Bool
forall k (n :: k). Set n -> Bool
AlignableSet.null T VarNum
rvs
            then () -> ExceptT (T VarNum) (State (Context start varDoc altDoc a)) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            else T VarNum
-> ExceptT (T VarNum) (State (Context start varDoc altDoc a)) ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE T VarNum
rvs

type Pipeline start varDoc altDoc a =
    ExceptT (AlignableSet.T PEG.VarNum) (State (Context start varDoc altDoc a))

data Context start varDoc altDoc a = Context
    { Context start varDoc altDoc a -> Context start varDoc altDoc a
ctxBuilder        :: LAPEGBuilder.Context start varDoc altDoc a
    , Context start varDoc altDoc a -> T VarNum VarNum
ctxVarMap         :: AlignableMap.T PEG.VarNum LAPEG.VarNum
    , Context start varDoc altDoc a -> T VarNum (Maybe HeadRange)
ctxAvailableRuleRanges     :: AlignableMap.T LAPEG.VarNum (Maybe LAPEG.HeadRange)
    , Context start varDoc altDoc a
-> [(VarNum, HeadRange, [Alt altDoc a])]
ctxUpdateRuleStack :: [(LAPEG.VarNum, LAPEG.HeadRange, [PEG.Alt altDoc a])]
    , Context start varDoc altDoc a -> T VarNum (Var varDoc)
ctxOriginalVars :: AlignableArray.T PEG.VarNum (PEG.Var varDoc)
    , Context start varDoc altDoc a -> T VarNum Rule
ctxOriginalRules  :: AlignableArray.T PEG.VarNum PEG.Rule
    , Context start varDoc altDoc a -> T AltNum (Alt altDoc a)
ctxOriginalAlts  :: AlignableArray.T PEG.AltNum (PEG.Alt altDoc a)
    }

pegInitialPipeline :: Enum start
    => start -> PEG.VarNum -> Pipeline start varDoc altDoc a ()
pegInitialPipeline :: start -> VarNum -> Pipeline start varDoc altDoc a ()
pegInitialPipeline start
s VarNum
v = do
    VarNum
newV <- VarNum -> Pipeline start varDoc altDoc a (Maybe VarNum)
forall start varDoc altDoc a.
VarNum -> Pipeline start varDoc altDoc a (Maybe VarNum)
getAvailableVar VarNum
v Pipeline start varDoc altDoc a (Maybe VarNum)
-> (Maybe VarNum
    -> ExceptT
         (T VarNum) (State (Context start varDoc altDoc a)) VarNum)
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) VarNum
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just VarNum
x ->
            VarNum
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) VarNum
forall (f :: * -> *) a. Applicative f => a -> f a
pure VarNum
x
        Maybe VarNum
Nothing -> do
            (VarNum
x, HeadRange
_) <- VarNum -> Pipeline start varDoc altDoc a (VarNum, HeadRange)
forall start varDoc altDoc a.
VarNum -> Pipeline start varDoc altDoc a (VarNum, HeadRange)
pegVarPipeline VarNum
v
            VarNum
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) VarNum
forall (f :: * -> *) a. Applicative f => a -> f a
pure VarNum
x
    Pipeline start varDoc altDoc a ()
forall start varDoc altDoc a. Pipeline start varDoc altDoc a ()
pegRuleStackPipeline
    T start varDoc altDoc a Identity ()
-> Pipeline start varDoc altDoc a ()
forall start varDoc altDoc a r.
T start varDoc altDoc a Identity r
-> Pipeline start varDoc altDoc a r
liftBuilder do start -> VarNum -> T start varDoc altDoc a Identity ()
forall (m :: * -> *) start varDoc altDoc a.
(Monad m, Enum start) =>
start -> VarNum -> BuilderT start varDoc altDoc a m ()
LAPEGBuilder.addInitial start
s VarNum
newV

pegRuleStackPipeline :: Pipeline start varDoc altDoc a ()
pegRuleStackPipeline :: Pipeline start varDoc altDoc a ()
pegRuleStackPipeline = Pipeline
  start varDoc altDoc a (Maybe (VarNum, HeadRange, [Alt altDoc a]))
forall start varDoc altDoc a.
Pipeline
  start varDoc altDoc a (Maybe (VarNum, HeadRange, [Alt altDoc a]))
popUpdateRuleItem Pipeline
  start varDoc altDoc a (Maybe (VarNum, HeadRange, [Alt altDoc a]))
-> (Maybe (VarNum, HeadRange, [Alt altDoc a])
    -> Pipeline start varDoc altDoc a ())
-> Pipeline start varDoc altDoc a ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (VarNum, HeadRange, [Alt altDoc a])
Nothing ->
        () -> Pipeline start varDoc altDoc a ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just (VarNum
newV, HeadRange
newRange, [Alt altDoc a]
rule) -> do
        VarNum
-> HeadRange -> [Alt altDoc a] -> Pipeline start varDoc altDoc a ()
forall altDoc a start varDoc.
VarNum
-> HeadRange -> [Alt altDoc a] -> Pipeline start varDoc altDoc a ()
pegRulePipeline VarNum
newV HeadRange
newRange [Alt altDoc a]
rule
        Pipeline start varDoc altDoc a ()
forall start varDoc altDoc a. Pipeline start varDoc altDoc a ()
pegRuleStackPipeline

pegVarPipeline
    :: PEG.VarNum -> Pipeline start varDoc altDoc a (LAPEG.VarNum, LAPEG.HeadRange)
pegVarPipeline :: VarNum -> Pipeline start varDoc altDoc a (VarNum, HeadRange)
pegVarPipeline VarNum
v = do
    VarNum
newV <- VarNum -> Pipeline start varDoc altDoc a VarNum
forall start varDoc altDoc a.
VarNum -> Pipeline start varDoc altDoc a VarNum
getNewVar VarNum
v
    T VarNum (Maybe HeadRange)
availableRuleRanges <- (Context start varDoc altDoc a -> T VarNum (Maybe HeadRange))
-> Pipeline start varDoc altDoc a (T VarNum (Maybe HeadRange))
forall start varDoc altDoc a r.
(Context start varDoc altDoc a -> r)
-> Pipeline start varDoc altDoc a r
getCtx Context start varDoc altDoc a -> T VarNum (Maybe HeadRange)
forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum (Maybe HeadRange)
ctxAvailableRuleRanges
    case VarNum -> T VarNum (Maybe HeadRange) -> Maybe (Maybe HeadRange)
forall n a. T n => n -> Map n a -> Maybe a
AlignableMap.lookup VarNum
newV T VarNum (Maybe HeadRange)
availableRuleRanges of
        Maybe (Maybe HeadRange)
Nothing ->
            VarNum -> Pipeline start varDoc altDoc a (VarNum, HeadRange)
goVarUpdate VarNum
newV
        Just Maybe HeadRange
Nothing ->
            VarNum -> Pipeline start varDoc altDoc a (VarNum, HeadRange)
forall start varDoc altDoc a r.
VarNum -> Pipeline start varDoc altDoc a r
throwV VarNum
v
        Just (Just HeadRange
hr) ->
            (VarNum, HeadRange)
-> Pipeline start varDoc altDoc a (VarNum, HeadRange)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VarNum
newV, HeadRange
hr)
    where
        goVarUpdate :: VarNum -> Pipeline start varDoc altDoc a (VarNum, HeadRange)
goVarUpdate VarNum
newV = do
            T VarNum Rule
pegRules <- (Context start varDoc altDoc a -> T VarNum Rule)
-> Pipeline start varDoc altDoc a (T VarNum Rule)
forall start varDoc altDoc a r.
(Context start varDoc altDoc a -> r)
-> Pipeline start varDoc altDoc a r
getCtx Context start varDoc altDoc a -> T VarNum Rule
forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum Rule
ctxOriginalRules
            let rule :: Rule
rule = T VarNum Rule -> VarNum -> Rule
forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex T VarNum Rule
pegRules VarNum
v
            HeadRange
hr <- VarNum -> Rule -> Pipeline start varDoc altDoc a HeadRange
forall start varDoc altDoc a.
VarNum -> Rule -> Pipeline start varDoc altDoc a HeadRange
pegRuleHeadRangePipeline VarNum
newV Rule
rule
            (VarNum, HeadRange)
-> Pipeline start varDoc altDoc a (VarNum, HeadRange)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VarNum
newV, HeadRange
hr)

pegRuleHeadRangePipeline
    :: LAPEG.VarNum -> PEG.Rule
    -> Pipeline start varDoc altDoc a LAPEG.HeadRange
pegRuleHeadRangePipeline :: VarNum -> Rule -> Pipeline start varDoc altDoc a HeadRange
pegRuleHeadRangePipeline VarNum
newV (PEG.Rule [AltNum]
altns) = do
    T AltNum (Alt altDoc a)
originalAlts <- (Context start varDoc altDoc a -> T AltNum (Alt altDoc a))
-> Pipeline start varDoc altDoc a (T AltNum (Alt altDoc a))
forall start varDoc altDoc a r.
(Context start varDoc altDoc a -> r)
-> Pipeline start varDoc altDoc a r
getCtx Context start varDoc altDoc a -> T AltNum (Alt altDoc a)
forall start varDoc altDoc a.
Context start varDoc altDoc a -> T AltNum (Alt altDoc a)
ctxOriginalAlts
    let alts :: [Alt altDoc a]
alts = [ T AltNum (Alt altDoc a) -> AltNum -> Alt altDoc a
forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex T AltNum (Alt altDoc a)
originalAlts AltNum
altn | AltNum
altn <- [AltNum]
altns ]
    VarNum -> Pipeline start varDoc altDoc a ()
forall start varDoc altDoc a.
VarNum -> Pipeline start varDoc altDoc a ()
startUpdateAvailableRuleRange VarNum
newV
    HeadRange
newRange <- (HeadRange
 -> Alt altDoc a -> Pipeline start varDoc altDoc a HeadRange)
-> HeadRange
-> [Alt altDoc a]
-> Pipeline start varDoc altDoc a HeadRange
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
        do \HeadRange
hr0 Alt altDoc a
alt -> do
            HeadRange
hr <- Alt altDoc a -> Pipeline start varDoc altDoc a HeadRange
forall altDoc a start varDoc.
Alt altDoc a -> Pipeline start varDoc altDoc a HeadRange
pegAltHeadRangePipeline Alt altDoc a
alt
            HeadRange -> Pipeline start varDoc altDoc a HeadRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure do HeadRange
hr0 HeadRange -> HeadRange -> HeadRange
forall a. Semigroup a => a -> a -> a
<> HeadRange
hr
        do HeadRange
forall a. Monoid a => a
mempty
        do [Alt altDoc a]
alts
    VarNum -> HeadRange -> Pipeline start varDoc altDoc a ()
forall start varDoc altDoc a.
VarNum -> HeadRange -> Pipeline start varDoc altDoc a ()
saveNewRuleRange VarNum
newV HeadRange
newRange
    VarNum
-> HeadRange -> [Alt altDoc a] -> Pipeline start varDoc altDoc a ()
forall altDoc a start varDoc.
VarNum
-> HeadRange -> [Alt altDoc a] -> Pipeline start varDoc altDoc a ()
pushUpdateRuleItem VarNum
newV HeadRange
newRange [Alt altDoc a]
alts
    HeadRange -> Pipeline start varDoc altDoc a HeadRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure HeadRange
newRange

pegAltHeadRangePipeline
    :: PEG.Alt altDoc a -> Pipeline start varDoc altDoc a LAPEG.HeadRange
pegAltHeadRangePipeline :: Alt altDoc a -> Pipeline start varDoc altDoc a HeadRange
pegAltHeadRangePipeline Alt altDoc a
alt =
    case Alt altDoc a -> AltKind
forall altDoc a. Alt altDoc a -> AltKind
PEG.altKind Alt altDoc a
alt of
        AltKind
PEG.AltSeq -> Pipeline start varDoc altDoc a HeadRange
goStraight
        AltKind
PEG.AltNot -> Pipeline start varDoc altDoc a HeadRange
goNegative
        AltKind
PEG.AltAnd -> Pipeline start varDoc altDoc a HeadRange
goStraight
    where
        goStraight :: Pipeline start varDoc altDoc a HeadRange
goStraight = [Unit] -> Pipeline start varDoc altDoc a HeadRange
forall start varDoc altDoc a.
[Unit]
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) HeadRange
goUnits0 do Alt altDoc a -> [Unit]
forall altDoc a. Alt altDoc a -> [Unit]
PEG.altUnitSeq Alt altDoc a
alt

        goNegative :: Pipeline start varDoc altDoc a HeadRange
goNegative = do
            HeadRange
hr <- [Unit] -> Pipeline start varDoc altDoc a HeadRange
forall start varDoc altDoc a.
[Unit]
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) HeadRange
goUnits0 do Alt altDoc a -> [Unit]
forall altDoc a. Alt altDoc a -> [Unit]
PEG.altUnitSeq Alt altDoc a
alt
            let notHr :: HeadRange
notHr = if
                    | HeadRange -> Bool
LAPEG.headRangeEpsilon HeadRange
hr ->
                        HeadRange
forall a. Monoid a => a
mempty
                    | Bool
otherwise ->
                        HeadRange :: Bool -> T -> HeadRange
LAPEG.HeadRange
                            { $sel:headRangeEpsilon:HeadRange :: Bool
headRangeEpsilon = Bool
True
                            , $sel:headRangeConsume:HeadRange :: T
headRangeConsume = T
SymbolicIntSet.full
                            }
            HeadRange -> Pipeline start varDoc altDoc a HeadRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure HeadRange
notHr

        goUnits0 :: [Unit]
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) HeadRange
goUnits0 [Unit]
us = T
-> [Unit]
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) HeadRange
forall start varDoc altDoc a.
T
-> [Unit]
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) HeadRange
goUnits T
forall a. Monoid a => a
mempty [Unit]
us

        goUnits :: T
-> [Unit]
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) HeadRange
goUnits T
consumeRange0 = \case
            [] -> do
                let hr :: HeadRange
hr = HeadRange :: Bool -> T -> HeadRange
LAPEG.HeadRange
                        { $sel:headRangeEpsilon:HeadRange :: Bool
headRangeEpsilon = Bool
True
                        , $sel:headRangeConsume:HeadRange :: T
headRangeConsume = T
consumeRange0
                        }
                HeadRange
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) HeadRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure HeadRange
hr
            Unit
u:[Unit]
us -> do
                (Unit
_, HeadRange
hr) <- Unit -> Pipeline start varDoc altDoc a (Unit, HeadRange)
forall start varDoc altDoc a.
Unit -> Pipeline start varDoc altDoc a (Unit, HeadRange)
pegUnitPipeline Unit
u
                let consumeRange1 :: T
consumeRange1 = T
consumeRange0 T -> T -> T
forall a. Semigroup a => a -> a -> a
<> HeadRange -> T
LAPEG.headRangeConsume HeadRange
hr
                if HeadRange -> Bool
LAPEG.headRangeEpsilon HeadRange
hr
                    then
                        T
-> [Unit]
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) HeadRange
goUnits T
consumeRange1 [Unit]
us
                    else do
                        let hr1 :: HeadRange
hr1 = HeadRange :: Bool -> T -> HeadRange
LAPEG.HeadRange
                                { $sel:headRangeEpsilon:HeadRange :: Bool
headRangeEpsilon = Bool
False
                                , $sel:headRangeConsume:HeadRange :: T
headRangeConsume = T
consumeRange1
                                }
                        HeadRange
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) HeadRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure HeadRange
hr1

pegRulePipeline
    :: LAPEG.VarNum -> LAPEG.HeadRange -> [PEG.Alt altDoc a]
    -> Pipeline start varDoc altDoc a ()
pegRulePipeline :: VarNum
-> HeadRange -> [Alt altDoc a] -> Pipeline start varDoc altDoc a ()
pegRulePipeline VarNum
newV HeadRange
newRange [Alt altDoc a]
alts = do
    [AltNum]
newAlts <- [Alt altDoc a]
-> (Alt altDoc a
    -> ExceptT
         (T VarNum) (State (Context start varDoc altDoc a)) AltNum)
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) [AltNum]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Alt altDoc a]
alts \Alt altDoc a
alt -> VarNum
-> Alt altDoc a
-> ExceptT
     (T VarNum) (State (Context start varDoc altDoc a)) AltNum
forall altDoc a start varDoc.
VarNum -> Alt altDoc a -> Pipeline start varDoc altDoc a AltNum
pegAltPipeline VarNum
newV Alt altDoc a
alt
    let newRule :: Rule
newRule = Rule :: HeadRange -> [AltNum] -> Rule
LAPEG.Rule
            { $sel:ruleRange:Rule :: HeadRange
ruleRange = HeadRange
newRange
            , $sel:ruleAlts:Rule :: [AltNum]
ruleAlts = [AltNum]
newAlts
            }
    T start varDoc altDoc a Identity ()
-> Pipeline start varDoc altDoc a ()
forall start varDoc altDoc a r.
T start varDoc altDoc a Identity r
-> Pipeline start varDoc altDoc a r
liftBuilder do VarNum -> Rule -> T start varDoc altDoc a Identity ()
forall (m :: * -> *) start varDoc altDoc a.
Monad m =>
VarNum -> Rule -> BuilderT start varDoc altDoc a m ()
LAPEGBuilder.addRule VarNum
newV Rule
newRule

pegAltPipeline
    :: LAPEG.VarNum -> PEG.Alt altDoc a
    -> Pipeline start varDoc altDoc a LAPEG.AltNum
pegAltPipeline :: VarNum -> Alt altDoc a -> Pipeline start varDoc altDoc a AltNum
pegAltPipeline VarNum
newV Alt altDoc a
alt =
    case Alt altDoc a -> AltKind
forall altDoc a. Alt altDoc a -> AltKind
PEG.altKind Alt altDoc a
alt of
        AltKind
PEG.AltSeq -> Pipeline start varDoc altDoc a AltNum
goStraight
        AltKind
PEG.AltNot -> Pipeline start varDoc altDoc a AltNum
goNegative
        AltKind
PEG.AltAnd -> Pipeline start varDoc altDoc a AltNum
goStraight
    where
        goStraight :: Pipeline start varDoc altDoc a AltNum
goStraight = do
            (HeadRange
_, [(HeadRange, Unit)]
newUs) <- [Unit]
-> ExceptT
     (T VarNum)
     (State (Context start varDoc altDoc a))
     (HeadRange, [(HeadRange, Unit)])
forall start varDoc altDoc a.
[Unit]
-> ExceptT
     (T VarNum)
     (State (Context start varDoc altDoc a))
     (HeadRange, [(HeadRange, Unit)])
goUnits do Alt altDoc a -> [Unit]
forall altDoc a. Alt altDoc a -> [Unit]
PEG.altUnitSeq Alt altDoc a
alt
            AltNum
newAlt <- [(HeadRange, Unit)] -> Pipeline start varDoc altDoc a AltNum
genNewAltNum [(HeadRange, Unit)]
newUs
            AltNum -> Pipeline start varDoc altDoc a AltNum
forall (f :: * -> *) a. Applicative f => a -> f a
pure AltNum
newAlt

        goNegative :: Pipeline start varDoc altDoc a AltNum
goNegative = do
            (HeadRange
hr, [(HeadRange, Unit)]
newUs) <- [Unit]
-> ExceptT
     (T VarNum)
     (State (Context start varDoc altDoc a))
     (HeadRange, [(HeadRange, Unit)])
forall start varDoc altDoc a.
[Unit]
-> ExceptT
     (T VarNum)
     (State (Context start varDoc altDoc a))
     (HeadRange, [(HeadRange, Unit)])
goUnits do Alt altDoc a -> [Unit]
forall altDoc a. Alt altDoc a -> [Unit]
PEG.altUnitSeq Alt altDoc a
alt
            let notHr :: HeadRange
notHr = if
                    | HeadRange -> Bool
LAPEG.headRangeEpsilon HeadRange
hr ->
                        HeadRange
forall a. Monoid a => a
mempty
                    | Bool
otherwise ->
                        HeadRange :: Bool -> T -> HeadRange
LAPEG.HeadRange
                            { $sel:headRangeEpsilon:HeadRange :: Bool
headRangeEpsilon = Bool
True
                            , $sel:headRangeConsume:HeadRange :: T
headRangeConsume = T
SymbolicIntSet.full
                            }
            AltNum
newAlt <- [(HeadRange, Unit)] -> Pipeline start varDoc altDoc a AltNum
genNewAltNum do (HeadRange
notHr, Unit
LAPEG.UnitNot)(HeadRange, Unit) -> [(HeadRange, Unit)] -> [(HeadRange, Unit)]
forall a. a -> [a] -> [a]
:[(HeadRange, Unit)]
newUs
            AltNum -> Pipeline start varDoc altDoc a AltNum
forall (f :: * -> *) a. Applicative f => a -> f a
pure AltNum
newAlt

        genNewAltNum :: [(HeadRange, Unit)] -> Pipeline start varDoc altDoc a AltNum
genNewAltNum [(HeadRange, Unit)]
newUs = do
            let newAlt :: Alt altDoc a
newAlt = Alt :: forall altDoc a.
VarNum
-> AltKind
-> T Position (HeadRange, Unit)
-> a
-> altDoc
-> Alt altDoc a
LAPEG.Alt
                    { $sel:altVar:Alt :: VarNum
altVar = VarNum
newV
                    , $sel:altUnitSeqWithLookAHead:Alt :: T Position (HeadRange, Unit)
altUnitSeqWithLookAHead = [(HeadRange, Unit)] -> T Position (HeadRange, Unit)
forall n a. T n => [a] -> Array n a
AlignableArray.fromList [(HeadRange, Unit)]
newUs
                    , $sel:altKind:Alt :: AltKind
altKind = Alt altDoc a -> AltKind
forall altDoc a. Alt altDoc a -> AltKind
PEG.altKind Alt altDoc a
alt
                    , $sel:altAction:Alt :: a
altAction = Alt altDoc a -> a
forall altDoc a. Alt altDoc a -> a
PEG.altAction Alt altDoc a
alt
                    , $sel:altHelp:Alt :: altDoc
altHelp = Alt altDoc a -> altDoc
forall altDoc a. Alt altDoc a -> altDoc
PEG.altHelp Alt altDoc a
alt
                    }
            T start varDoc altDoc a Identity AltNum
-> Pipeline start varDoc altDoc a AltNum
forall start varDoc altDoc a r.
T start varDoc altDoc a Identity r
-> Pipeline start varDoc altDoc a r
liftBuilder do Alt altDoc a -> T start varDoc altDoc a Identity AltNum
forall (m :: * -> *) altDoc a start varDoc.
Monad m =>
Alt altDoc a -> BuilderT start varDoc altDoc a m AltNum
LAPEGBuilder.genNewAlt Alt altDoc a
newAlt

        goUnits :: [Unit]
-> ExceptT
     (T VarNum)
     (State (Context start varDoc altDoc a))
     (HeadRange, [(HeadRange, Unit)])
goUnits [Unit]
us = do
            let hr0 :: HeadRange
hr0 = HeadRange :: Bool -> T -> HeadRange
LAPEG.HeadRange
                    { $sel:headRangeEpsilon:HeadRange :: Bool
headRangeEpsilon = Bool
True
                    , $sel:headRangeConsume:HeadRange :: T
headRangeConsume = T
forall a. Monoid a => a
mempty
                    }
            HeadRange
-> [(HeadRange, Unit)]
-> [Unit]
-> ExceptT
     (T VarNum)
     (State (Context start varDoc altDoc a))
     (HeadRange, [(HeadRange, Unit)])
forall start varDoc altDoc a.
HeadRange
-> [(HeadRange, Unit)]
-> [Unit]
-> ExceptT
     (T VarNum)
     (State (Context start varDoc altDoc a))
     (HeadRange, [(HeadRange, Unit)])
goRevUnits HeadRange
hr0 [] do [Unit] -> [Unit]
forall a. [a] -> [a]
reverse [Unit]
us

        goRevUnits :: HeadRange
-> [(HeadRange, Unit)]
-> [Unit]
-> ExceptT
     (T VarNum)
     (State (Context start varDoc altDoc a))
     (HeadRange, [(HeadRange, Unit)])
goRevUnits HeadRange
postRange [(HeadRange, Unit)]
newUs = \case
            [] ->
                (HeadRange, [(HeadRange, Unit)])
-> ExceptT
     (T VarNum)
     (State (Context start varDoc altDoc a))
     (HeadRange, [(HeadRange, Unit)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HeadRange
postRange, [(HeadRange, Unit)]
newUs)
            Unit
u:[Unit]
revUs -> do
                (Unit
newU, HeadRange
hrU) <- Unit -> Pipeline start varDoc altDoc a (Unit, HeadRange)
forall start varDoc altDoc a.
Unit -> Pipeline start varDoc altDoc a (Unit, HeadRange)
pegUnitPipeline Unit
u
                let hrUWithPost :: HeadRange
hrUWithPost = if HeadRange -> Bool
LAPEG.headRangeEpsilon HeadRange
hrU
                        then HeadRange :: Bool -> T -> HeadRange
LAPEG.HeadRange
                            { $sel:headRangeEpsilon:HeadRange :: Bool
headRangeEpsilon =
                                HeadRange -> Bool
LAPEG.headRangeEpsilon HeadRange
postRange
                            , $sel:headRangeConsume:HeadRange :: T
headRangeConsume =
                                HeadRange -> T
LAPEG.headRangeConsume HeadRange
hrU T -> T -> T
forall a. Semigroup a => a -> a -> a
<> HeadRange -> T
LAPEG.headRangeConsume HeadRange
postRange
                            }
                        else HeadRange
hrU
                HeadRange
-> [(HeadRange, Unit)]
-> [Unit]
-> ExceptT
     (T VarNum)
     (State (Context start varDoc altDoc a))
     (HeadRange, [(HeadRange, Unit)])
goRevUnits HeadRange
hrUWithPost ((HeadRange
hrUWithPost, Unit
newU)(HeadRange, Unit) -> [(HeadRange, Unit)] -> [(HeadRange, Unit)]
forall a. a -> [a] -> [a]
:[(HeadRange, Unit)]
newUs) [Unit]
revUs

pegUnitPipeline
    :: PEG.Unit -> Pipeline start varDoc altDoc a (LAPEG.Unit, LAPEG.HeadRange)
pegUnitPipeline :: Unit -> Pipeline start varDoc altDoc a (Unit, HeadRange)
pegUnitPipeline = \case
    PEG.UnitTerminal Terminal
t -> do
        let hr :: HeadRange
hr = HeadRange :: Bool -> T -> HeadRange
LAPEG.HeadRange
                { $sel:headRangeEpsilon:HeadRange :: Bool
headRangeEpsilon = Bool
False
                , $sel:headRangeConsume:HeadRange :: T
headRangeConsume = Terminal -> T
SymbolicIntSet.singleton Terminal
t
                }
        (Unit, HeadRange)
-> Pipeline start varDoc altDoc a (Unit, HeadRange)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Terminal -> Unit
LAPEG.UnitTerminal Terminal
t, HeadRange
hr)
    PEG.UnitNonTerminal VarNum
v -> do
        (VarNum
newV, HeadRange
hr) <- VarNum -> Pipeline start varDoc altDoc a (VarNum, HeadRange)
forall start varDoc altDoc a.
VarNum -> Pipeline start varDoc altDoc a (VarNum, HeadRange)
pegVarPipeline VarNum
v
        (Unit, HeadRange)
-> Pipeline start varDoc altDoc a (Unit, HeadRange)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VarNum -> Unit
LAPEG.UnitNonTerminal VarNum
newV, HeadRange
hr)

getNewVar :: PEG.VarNum -> Pipeline start varDoc altDoc a LAPEG.VarNum
getNewVar :: VarNum -> Pipeline start varDoc altDoc a VarNum
getNewVar VarNum
vn = do
    T VarNum VarNum
vm0 <- (Context start varDoc altDoc a -> T VarNum VarNum)
-> Pipeline start varDoc altDoc a (T VarNum VarNum)
forall start varDoc altDoc a r.
(Context start varDoc altDoc a -> r)
-> Pipeline start varDoc altDoc a r
getCtx Context start varDoc altDoc a -> T VarNum VarNum
forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum VarNum
ctxVarMap
    case VarNum -> T VarNum VarNum -> Maybe VarNum
forall n a. T n => n -> Map n a -> Maybe a
AlignableMap.lookup VarNum
vn T VarNum VarNum
vm0 of
        Just VarNum
newV ->
            VarNum -> Pipeline start varDoc altDoc a VarNum
forall (f :: * -> *) a. Applicative f => a -> f a
pure VarNum
newV
        Maybe VarNum
Nothing -> do
            T VarNum (Var varDoc)
originalVars <- (Context start varDoc altDoc a -> T VarNum (Var varDoc))
-> Pipeline start varDoc altDoc a (T VarNum (Var varDoc))
forall start varDoc altDoc a r.
(Context start varDoc altDoc a -> r)
-> Pipeline start varDoc altDoc a r
getCtx Context start varDoc altDoc a -> T VarNum (Var varDoc)
forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum (Var varDoc)
ctxOriginalVars
            let v :: Var varDoc
v = T VarNum (Var varDoc) -> VarNum -> Var varDoc
forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex T VarNum (Var varDoc)
originalVars VarNum
vn
            VarNum
newV <- T start varDoc altDoc a Identity VarNum
-> Pipeline start varDoc altDoc a VarNum
forall start varDoc altDoc a r.
T start varDoc altDoc a Identity r
-> Pipeline start varDoc altDoc a r
liftBuilder do Var varDoc -> T start varDoc altDoc a Identity VarNum
forall (m :: * -> *) varDoc start altDoc a.
Monad m =>
Var varDoc -> BuilderT start varDoc altDoc a m VarNum
LAPEGBuilder.genNewVar Var varDoc
v
            StateT (Context start varDoc altDoc a) Identity ()
-> ExceptT
     (T VarNum) (StateT (Context start varDoc altDoc a) Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
                (Context start varDoc altDoc a -> Context start varDoc altDoc a)
-> StateT (Context start varDoc altDoc a) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \Context start varDoc altDoc a
ctx -> Context start varDoc altDoc a
ctx
                    {
                        $sel:ctxVarMap:Context :: T VarNum VarNum
ctxVarMap = VarNum -> VarNum -> T VarNum VarNum -> T VarNum VarNum
forall n a. T n => n -> a -> Map n a -> Map n a
AlignableMap.insert VarNum
vn VarNum
newV
                            do Context start varDoc altDoc a -> T VarNum VarNum
forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum VarNum
ctxVarMap Context start varDoc altDoc a
ctx
                    }
            VarNum -> Pipeline start varDoc altDoc a VarNum
forall (f :: * -> *) a. Applicative f => a -> f a
pure VarNum
newV

startUpdateAvailableRuleRange :: LAPEG.VarNum -> Pipeline start varDoc altDoc a ()
startUpdateAvailableRuleRange :: VarNum -> Pipeline start varDoc altDoc a ()
startUpdateAvailableRuleRange VarNum
newV = StateT (Context start varDoc altDoc a) Identity ()
-> Pipeline start varDoc altDoc a ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
    (Context start varDoc altDoc a -> Context start varDoc altDoc a)
-> StateT (Context start varDoc altDoc a) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \Context start varDoc altDoc a
ctx -> Context start varDoc altDoc a
ctx
        { $sel:ctxAvailableRuleRanges:Context :: T VarNum (Maybe HeadRange)
ctxAvailableRuleRanges = VarNum
-> Maybe HeadRange
-> T VarNum (Maybe HeadRange)
-> T VarNum (Maybe HeadRange)
forall n a. T n => n -> a -> Map n a -> Map n a
AlignableMap.insert VarNum
newV
            do Maybe HeadRange
forall a. Maybe a
Nothing
            do Context start varDoc altDoc a -> T VarNum (Maybe HeadRange)
forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum (Maybe HeadRange)
ctxAvailableRuleRanges Context start varDoc altDoc a
ctx
        }

saveNewRuleRange
    :: LAPEG.VarNum -> LAPEG.HeadRange
    -> Pipeline start varDoc altDoc a ()
saveNewRuleRange :: VarNum -> HeadRange -> Pipeline start varDoc altDoc a ()
saveNewRuleRange VarNum
newV HeadRange
hr = StateT (Context start varDoc altDoc a) Identity ()
-> Pipeline start varDoc altDoc a ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
    (Context start varDoc altDoc a -> Context start varDoc altDoc a)
-> StateT (Context start varDoc altDoc a) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \Context start varDoc altDoc a
ctx -> Context start varDoc altDoc a
ctx
        { $sel:ctxAvailableRuleRanges:Context :: T VarNum (Maybe HeadRange)
ctxAvailableRuleRanges = VarNum
-> Maybe HeadRange
-> T VarNum (Maybe HeadRange)
-> T VarNum (Maybe HeadRange)
forall n a. T n => n -> a -> Map n a -> Map n a
AlignableMap.insert VarNum
newV
            do HeadRange -> Maybe HeadRange
forall a. a -> Maybe a
Just HeadRange
hr
            do Context start varDoc altDoc a -> T VarNum (Maybe HeadRange)
forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum (Maybe HeadRange)
ctxAvailableRuleRanges Context start varDoc altDoc a
ctx
        }

getAvailableVar
    :: PEG.VarNum -> Pipeline start varDoc altDoc a (Maybe LAPEG.VarNum)
getAvailableVar :: VarNum -> Pipeline start varDoc altDoc a (Maybe VarNum)
getAvailableVar VarNum
v = do
    Context start varDoc altDoc a
ctx <- StateT
  (Context start varDoc altDoc a)
  Identity
  (Context start varDoc altDoc a)
-> ExceptT
     (T VarNum)
     (StateT (Context start varDoc altDoc a) Identity)
     (Context start varDoc altDoc a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT
  (Context start varDoc altDoc a)
  Identity
  (Context start varDoc altDoc a)
forall (m :: * -> *) s. Monad m => StateT s m s
get
    case VarNum -> T VarNum VarNum -> Maybe VarNum
forall n a. T n => n -> Map n a -> Maybe a
AlignableMap.lookup VarNum
v do Context start varDoc altDoc a -> T VarNum VarNum
forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum VarNum
ctxVarMap Context start varDoc altDoc a
ctx of
        Maybe VarNum
Nothing ->
            Maybe VarNum -> Pipeline start varDoc altDoc a (Maybe VarNum)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VarNum
forall a. Maybe a
Nothing
        Just VarNum
newV -> case VarNum -> T VarNum (Maybe HeadRange) -> Maybe (Maybe HeadRange)
forall n a. T n => n -> Map n a -> Maybe a
AlignableMap.lookup VarNum
newV do Context start varDoc altDoc a -> T VarNum (Maybe HeadRange)
forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum (Maybe HeadRange)
ctxAvailableRuleRanges Context start varDoc altDoc a
ctx of
            Maybe (Maybe HeadRange)
Nothing ->
                Maybe VarNum -> Pipeline start varDoc altDoc a (Maybe VarNum)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VarNum
forall a. Maybe a
Nothing
            Just Maybe HeadRange
Nothing ->
                Maybe VarNum -> Pipeline start varDoc altDoc a (Maybe VarNum)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VarNum
forall a. Maybe a
Nothing
            Just Just{} ->
                Maybe VarNum -> Pipeline start varDoc altDoc a (Maybe VarNum)
forall (f :: * -> *) a. Applicative f => a -> f a
pure do VarNum -> Maybe VarNum
forall a. a -> Maybe a
Just VarNum
newV

popUpdateRuleItem
    :: Pipeline start varDoc altDoc a (Maybe (LAPEG.VarNum, LAPEG.HeadRange, [PEG.Alt altDoc a]))
popUpdateRuleItem :: Pipeline
  start varDoc altDoc a (Maybe (VarNum, HeadRange, [Alt altDoc a]))
popUpdateRuleItem = do
    [(VarNum, HeadRange, [Alt altDoc a])]
updateRuleStack <- (Context start varDoc altDoc a
 -> [(VarNum, HeadRange, [Alt altDoc a])])
-> Pipeline
     start varDoc altDoc a [(VarNum, HeadRange, [Alt altDoc a])]
forall start varDoc altDoc a r.
(Context start varDoc altDoc a -> r)
-> Pipeline start varDoc altDoc a r
getCtx Context start varDoc altDoc a
-> [(VarNum, HeadRange, [Alt altDoc a])]
forall start varDoc altDoc a.
Context start varDoc altDoc a
-> [(VarNum, HeadRange, [Alt altDoc a])]
ctxUpdateRuleStack
    case [(VarNum, HeadRange, [Alt altDoc a])]
updateRuleStack of
        [] ->
            Maybe (VarNum, HeadRange, [Alt altDoc a])
-> Pipeline
     start varDoc altDoc a (Maybe (VarNum, HeadRange, [Alt altDoc a]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (VarNum, HeadRange, [Alt altDoc a])
forall a. Maybe a
Nothing
        (VarNum, HeadRange, [Alt altDoc a])
item:[(VarNum, HeadRange, [Alt altDoc a])]
items -> do
            StateT (Context start varDoc altDoc a) Identity ()
-> ExceptT
     (T VarNum) (StateT (Context start varDoc altDoc a) Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do (Context start varDoc altDoc a -> Context start varDoc altDoc a)
-> StateT (Context start varDoc altDoc a) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \Context start varDoc altDoc a
ctx -> Context start varDoc altDoc a
ctx { $sel:ctxUpdateRuleStack:Context :: [(VarNum, HeadRange, [Alt altDoc a])]
ctxUpdateRuleStack = [(VarNum, HeadRange, [Alt altDoc a])]
items }
            Maybe (VarNum, HeadRange, [Alt altDoc a])
-> Pipeline
     start varDoc altDoc a (Maybe (VarNum, HeadRange, [Alt altDoc a]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure do (VarNum, HeadRange, [Alt altDoc a])
-> Maybe (VarNum, HeadRange, [Alt altDoc a])
forall a. a -> Maybe a
Just (VarNum, HeadRange, [Alt altDoc a])
item

pushUpdateRuleItem
    :: LAPEG.VarNum -> LAPEG.HeadRange -> [PEG.Alt altDoc a]
    -> Pipeline start varDoc altDoc a ()
pushUpdateRuleItem :: VarNum
-> HeadRange -> [Alt altDoc a] -> Pipeline start varDoc altDoc a ()
pushUpdateRuleItem VarNum
newV HeadRange
newRange [Alt altDoc a]
alts = StateT (Context start varDoc altDoc a) Identity ()
-> Pipeline start varDoc altDoc a ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
    (Context start varDoc altDoc a -> Context start varDoc altDoc a)
-> StateT (Context start varDoc altDoc a) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \Context start varDoc altDoc a
ctx -> Context start varDoc altDoc a
ctx
        { $sel:ctxUpdateRuleStack:Context :: [(VarNum, HeadRange, [Alt altDoc a])]
ctxUpdateRuleStack = (VarNum
newV, HeadRange
newRange, [Alt altDoc a]
alts)(VarNum, HeadRange, [Alt altDoc a])
-> [(VarNum, HeadRange, [Alt altDoc a])]
-> [(VarNum, HeadRange, [Alt altDoc a])]
forall a. a -> [a] -> [a]
:Context start varDoc altDoc a
-> [(VarNum, HeadRange, [Alt altDoc a])]
forall start varDoc altDoc a.
Context start varDoc altDoc a
-> [(VarNum, HeadRange, [Alt altDoc a])]
ctxUpdateRuleStack Context start varDoc altDoc a
ctx
        }

getCtx
    :: (Context start varDoc altDoc a -> r)
    -> Pipeline start varDoc altDoc a r
getCtx :: (Context start varDoc altDoc a -> r)
-> Pipeline start varDoc altDoc a r
getCtx Context start varDoc altDoc a -> r
f = Context start varDoc altDoc a -> r
f (Context start varDoc altDoc a -> r)
-> ExceptT
     (T VarNum)
     (StateT (Context start varDoc altDoc a) Identity)
     (Context start varDoc altDoc a)
-> Pipeline start varDoc altDoc a r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
  (Context start varDoc altDoc a)
  Identity
  (Context start varDoc altDoc a)
-> ExceptT
     (T VarNum)
     (StateT (Context start varDoc altDoc a) Identity)
     (Context start varDoc altDoc a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT
  (Context start varDoc altDoc a)
  Identity
  (Context start varDoc altDoc a)
forall (m :: * -> *) s. Monad m => StateT s m s
get

throwV :: PEG.VarNum -> Pipeline start varDoc altDoc a r
throwV :: VarNum -> Pipeline start varDoc altDoc a r
throwV VarNum
v = T VarNum -> Pipeline start varDoc altDoc a r
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE do VarNum -> T VarNum
forall n. T n => n -> Set n
AlignableSet.singleton VarNum
v

liftBuilder
    :: LAPEGBuilder.T start varDoc altDoc a Identity r
    -> Pipeline start varDoc altDoc a r
liftBuilder :: T start varDoc altDoc a Identity r
-> Pipeline start varDoc altDoc a r
liftBuilder T start varDoc altDoc a Identity r
builder = do
    Context start varDoc altDoc a
ctx <- StateT
  (Context start varDoc altDoc a)
  Identity
  (Context start varDoc altDoc a)
-> ExceptT
     (T VarNum)
     (StateT (Context start varDoc altDoc a) Identity)
     (Context start varDoc altDoc a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT
  (Context start varDoc altDoc a)
  Identity
  (Context start varDoc altDoc a)
forall (m :: * -> *) s. Monad m => StateT s m s
get
    let (r
x, Context start varDoc altDoc a
builderCtx) = T start varDoc altDoc a Identity r
-> Context start varDoc altDoc a
-> (r, Context start varDoc altDoc a)
forall s a. State s a -> s -> (a, s)
runState T start varDoc altDoc a Identity r
builder do Context start varDoc altDoc a -> Context start varDoc altDoc a
forall start varDoc altDoc a.
Context start varDoc altDoc a -> Context start varDoc altDoc a
ctxBuilder Context start varDoc altDoc a
ctx
    StateT (Context start varDoc altDoc a) Identity ()
-> ExceptT
     (T VarNum) (StateT (Context start varDoc altDoc a) Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do Context start varDoc altDoc a
-> StateT (Context start varDoc altDoc a) Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do Context start varDoc altDoc a
ctx { $sel:ctxBuilder:Context :: Context start varDoc altDoc a
ctxBuilder = Context start varDoc altDoc a
builderCtx }
    r -> Pipeline start varDoc altDoc a r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
x