module Language.Parser.Ptera.Pipeline.LAPEG2SRB where

import           Language.Parser.Ptera.Prelude

import qualified Data.EnumMap.Strict                        as EnumMap
import qualified Data.HashMap.Strict                        as HashMap
import qualified Data.List.NonEmpty                         as NonEmpty
import qualified Language.Parser.Ptera.Data.Alignable       as Alignable
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.Symbolic.IntMap as SymbolicIntMap
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.PEG          as PEG
import qualified Language.Parser.Ptera.Machine.SRB          as SRB
import qualified Language.Parser.Ptera.Machine.SRB.Builder  as SRBBuilder

laPeg2Srb :: Enum start
    => LAPEG.T start varDoc altDoc a -> SRB.T start varDoc altDoc a
laPeg2Srb :: T start varDoc altDoc a -> T start varDoc altDoc a
laPeg2Srb T start varDoc altDoc a
g = Identity (T start varDoc altDoc a) -> T start varDoc altDoc a
forall a. Identity a -> a
runIdentity do
        Vars varDoc
-> Alts altDoc a
-> BuilderT start a Identity ()
-> Identity (T start varDoc altDoc a)
forall (m :: * -> *) varDoc altDoc a start.
Monad m =>
Vars varDoc
-> Alts altDoc a
-> BuilderT start a m ()
-> m (T start varDoc altDoc a)
SRBBuilder.build
            do T start varDoc altDoc a -> Vars varDoc
forall start varDoc altDoc a.
LAPEG start varDoc altDoc a -> T VarNum (Var varDoc)
LAPEG.vars T start varDoc altDoc a
g
            do T start varDoc altDoc a -> Alts altDoc a
forall start varDoc altDoc a.
LAPEG start varDoc altDoc a -> T AltNum (Alt altDoc a)
LAPEG.alts T start varDoc altDoc a
g
            do BuilderT start a Identity ()
builder
    where
        builder :: BuilderT start a Identity ()
builder = do
            Context start a
initialBuilderCtx <- StateT (Context start a) Identity (Context start a)
forall (m :: * -> *) s. Monad m => StateT s m s
get
            let initialCtx :: Context start altDoc a
initialCtx = Context :: forall start altDoc a.
Context start a
-> T VarNum StateNum
-> T AltNum StateNum
-> T VarNum (T (Bool, StateNum))
-> HashMap (Position, NonEmpty AltNum) StateNum
-> [(StateNum, Position, NonEmpty AltNum)]
-> T VarNum Rule
-> T AltNum (Alt altDoc a)
-> Context start altDoc a
Context
                    { $sel:ctxBuilder:Context :: Context start a
ctxBuilder = Context start a
initialBuilderCtx
                    , $sel:ctxInitialVarState:Context :: T VarNum StateNum
ctxInitialVarState = T VarNum StateNum
forall k (n :: k) a. Map n a
AlignableMap.empty
                    , $sel:ctxReduceNotState:Context :: T AltNum StateNum
ctxReduceNotState = T AltNum StateNum
forall k (n :: k) a. Map n a
AlignableMap.empty
                    , $sel:ctxVarMap:Context :: T VarNum (T (Bool, StateNum))
ctxVarMap = T VarNum (T (Bool, StateNum))
forall k (n :: k) a. Map n a
AlignableMap.empty
                    , $sel:ctxStateMap:Context :: HashMap (Position, NonEmpty AltNum) StateNum
ctxStateMap = HashMap (Position, NonEmpty AltNum) StateNum
forall k v. HashMap k v
HashMap.empty
                    , $sel:ctxStateQueue:Context :: [(StateNum, Position, NonEmpty AltNum)]
ctxStateQueue = []
                    , $sel:ctxOriginalRules:Context :: T VarNum Rule
ctxOriginalRules = T start varDoc altDoc a -> T VarNum Rule
forall start varDoc altDoc a.
LAPEG start varDoc altDoc a -> T VarNum Rule
LAPEG.rules T start varDoc altDoc a
g
                    , $sel:ctxOriginalAlts:Context :: Alts altDoc a
ctxOriginalAlts = T start varDoc altDoc a -> Alts altDoc a
forall start varDoc altDoc a.
LAPEG start varDoc altDoc a -> T AltNum (Alt altDoc a)
LAPEG.alts T start varDoc altDoc a
g
                    }
            let finalCtx :: Context start altDoc a
finalCtx = State (Context start altDoc a) ()
-> Context start altDoc a -> Context start altDoc a
forall s a. State s a -> s -> s
execState State (Context start altDoc a) ()
pipeline Context start altDoc a
initialCtx
            Context start a -> BuilderT start a Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do Context start altDoc a -> Context start a
forall start altDoc a. Context start altDoc a -> Context start a
ctxBuilder Context start altDoc a
finalCtx

        pipeline :: State (Context start altDoc a) ()
pipeline = do
            [(start, VarNum)]
-> ((start, VarNum) -> State (Context start altDoc a) ())
-> State (Context start altDoc a) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
                do EnumMap start VarNum -> [(start, VarNum)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EnumMap.assocs do T start varDoc altDoc a -> EnumMap start VarNum
forall start varDoc altDoc a.
LAPEG start varDoc altDoc a -> EnumMap start VarNum
LAPEG.initials T start varDoc altDoc a
g
                do \(start
s, VarNum
v) -> start -> VarNum -> State (Context start altDoc a) ()
forall start altDoc a.
Enum start =>
start -> VarNum -> Pipeline start altDoc a ()
laPegInitialPipeline start
s VarNum
v
            State (Context start altDoc a) ()
forall start altDoc a. Pipeline start altDoc a ()
laPegStateQueuePipeline

type Pipeline start altDoc a = State (Context start altDoc a)

data Context start altDoc a = Context
    { Context start altDoc a -> Context start a
ctxBuilder :: SRBBuilder.Context start a
    , Context start altDoc a -> T VarNum StateNum
ctxInitialVarState :: AlignableMap.T LAPEG.VarNum SRB.StateNum
    , Context start altDoc a -> T AltNum StateNum
ctxReduceNotState :: AlignableMap.T LAPEG.AltNum SRB.StateNum
    , Context start altDoc a -> T VarNum (T (Bool, StateNum))
ctxVarMap  :: AlignableMap.T LAPEG.VarNum (SymbolicIntMap.T (Bool, SRB.StateNum))
    , Context start altDoc a
-> HashMap (Position, NonEmpty AltNum) StateNum
ctxStateMap :: HashMap.HashMap (LAPEG.Position, NonEmpty LAPEG.AltNum) SRB.StateNum
    , Context start altDoc a -> [(StateNum, Position, NonEmpty AltNum)]
ctxStateQueue :: [(SRB.StateNum, LAPEG.Position, NonEmpty LAPEG.AltNum)]
    , Context start altDoc a -> T VarNum Rule
ctxOriginalRules :: AlignableArray.T LAPEG.VarNum LAPEG.Rule
    , Context start altDoc a -> T AltNum (Alt altDoc a)
ctxOriginalAlts :: AlignableArray.T LAPEG.AltNum (LAPEG.Alt altDoc a)
    }

laPegInitialPipeline :: Enum start
    => start -> LAPEG.VarNum -> Pipeline start altDoc a ()
laPegInitialPipeline :: start -> VarNum -> Pipeline start altDoc a ()
laPegInitialPipeline start
s VarNum
v = do
    T VarNum StateNum
m0 <- (Context start altDoc a -> T VarNum StateNum)
-> Pipeline start altDoc a (T VarNum StateNum)
forall start altDoc a r.
(Context start altDoc a -> r) -> Pipeline start altDoc a r
getCtx Context start altDoc a -> T VarNum StateNum
forall start altDoc a. Context start altDoc a -> T VarNum StateNum
ctxInitialVarState
    StateNum
newSn <- case VarNum -> T VarNum StateNum -> Maybe StateNum
forall n a. T n => n -> Map n a -> Maybe a
AlignableMap.lookup VarNum
v T VarNum StateNum
m0 of
        Just StateNum
sn ->
            StateNum -> StateT (Context start altDoc a) Identity StateNum
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateNum
sn
        Maybe StateNum
Nothing -> do
            StateNum
sn <- T start a Identity StateNum
-> StateT (Context start altDoc a) Identity StateNum
forall start a r altDoc.
T start a Identity r -> Pipeline start altDoc a r
liftBuilder do T start a Identity StateNum
forall k (m :: * -> *) start (a :: k).
Monad m =>
BuilderT start a m StateNum
SRBBuilder.genNewStateNum
            (Context start altDoc a -> Context start altDoc a)
-> Pipeline start altDoc a ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \Context start altDoc a
ctx -> Context start altDoc a
ctx
                {
                    $sel:ctxInitialVarState:Context :: T VarNum StateNum
ctxInitialVarState = VarNum -> StateNum -> T VarNum StateNum -> T VarNum StateNum
forall n a. T n => n -> a -> Map n a -> Map n a
AlignableMap.insert VarNum
v StateNum
sn
                        do Context start altDoc a -> T VarNum StateNum
forall start altDoc a. Context start altDoc a -> T VarNum StateNum
ctxInitialVarState Context start altDoc a
ctx
                }
            T (Bool, StateNum)
m <- VarNum -> Pipeline start altDoc a (T (Bool, StateNum))
forall start altDoc a.
VarNum -> Pipeline start altDoc a (T (Bool, StateNum))
laPegVarPipeline VarNum
v
            let st :: MState
st = MState :: StateNum -> T Trans -> [AltItem] -> MState
SRB.MState
                    { $sel:stateNum:MState :: StateNum
stateNum = StateNum
sn
                    , $sel:stateTrans:MState :: T Trans
stateTrans = ((Bool, StateNum) -> Trans) -> T (Bool, StateNum) -> T Trans
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                        do \(Bool
needBack, StateNum
to) -> [TransOp] -> StateNum -> Trans
SRB.TransWithOps [VarNum -> Bool -> Maybe StateNum -> TransOp
SRB.TransOpEnter VarNum
v Bool
needBack Maybe StateNum
forall a. Maybe a
Nothing] StateNum
to
                        do T (Bool, StateNum)
m
                    , $sel:stateAltItems:MState :: [AltItem]
stateAltItems = []
                    }
            T start a Identity () -> Pipeline start altDoc a ()
forall start a r altDoc.
T start a Identity r -> Pipeline start altDoc a r
liftBuilder do MState -> T start a Identity ()
forall k (m :: * -> *) s (a :: k).
Monad m =>
MState -> BuilderT s a m ()
SRBBuilder.addState MState
st
            StateNum -> StateT (Context start altDoc a) Identity StateNum
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateNum
sn
    T start a Identity () -> Pipeline start altDoc a ()
forall start a r altDoc.
T start a Identity r -> Pipeline start altDoc a r
liftBuilder do start -> StateNum -> T start a Identity ()
forall k (m :: * -> *) start (a :: k).
(Monad m, Enum start) =>
start -> StateNum -> BuilderT start a m ()
SRBBuilder.registerInitial start
s StateNum
newSn

laPegStateQueuePipeline :: Pipeline start altDoc a ()
laPegStateQueuePipeline :: Pipeline start altDoc a ()
laPegStateQueuePipeline = do
    Context start altDoc a
ctx <- StateT (Context start altDoc a) Identity (Context start altDoc a)
forall (m :: * -> *) s. Monad m => StateT s m s
get
    case Context start altDoc a -> [(StateNum, Position, NonEmpty AltNum)]
forall start altDoc a.
Context start altDoc a -> [(StateNum, Position, NonEmpty AltNum)]
ctxStateQueue Context start altDoc a
ctx of
        [] ->
            () -> Pipeline start altDoc a ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        (StateNum
sn, Position
p, NonEmpty AltNum
alts):[(StateNum, Position, NonEmpty AltNum)]
rest -> do
            Context start altDoc a -> Pipeline start altDoc a ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do Context start altDoc a
ctx { $sel:ctxStateQueue:Context :: [(StateNum, Position, NonEmpty AltNum)]
ctxStateQueue = [(StateNum, Position, NonEmpty AltNum)]
rest }
            StateNum
-> Position -> NonEmpty AltNum -> Pipeline start altDoc a ()
forall start altDoc a.
StateNum
-> Position -> NonEmpty AltNum -> Pipeline start altDoc a ()
laPegStatePipeline StateNum
sn Position
p NonEmpty AltNum
alts
            Pipeline start altDoc a ()
forall start altDoc a. Pipeline start altDoc a ()
laPegStateQueuePipeline

laPegVarPipeline
    :: LAPEG.VarNum
    -> Pipeline start altDoc a (SymbolicIntMap.T (Bool, SRB.StateNum))
laPegVarPipeline :: VarNum -> Pipeline start altDoc a (T (Bool, StateNum))
laPegVarPipeline VarNum
v = do
    T VarNum (T (Bool, StateNum))
varMap <- (Context start altDoc a -> T VarNum (T (Bool, StateNum)))
-> Pipeline start altDoc a (T VarNum (T (Bool, StateNum)))
forall start altDoc a r.
(Context start altDoc a -> r) -> Pipeline start altDoc a r
getCtx Context start altDoc a -> T VarNum (T (Bool, StateNum))
forall start altDoc a.
Context start altDoc a -> T VarNum (T (Bool, StateNum))
ctxVarMap
    case VarNum
-> T VarNum (T (Bool, StateNum)) -> Maybe (T (Bool, StateNum))
forall n a. T n => n -> Map n a -> Maybe a
AlignableMap.lookup VarNum
v T VarNum (T (Bool, StateNum))
varMap of
        Just T (Bool, StateNum)
ss ->
            T (Bool, StateNum) -> Pipeline start altDoc a (T (Bool, StateNum))
forall (f :: * -> *) a. Applicative f => a -> f a
pure T (Bool, StateNum)
ss
        Maybe (T (Bool, StateNum))
Nothing -> do
            T VarNum Rule
rules <- (Context start altDoc a -> T VarNum Rule)
-> Pipeline start altDoc a (T VarNum Rule)
forall start altDoc a r.
(Context start altDoc a -> r) -> Pipeline start altDoc a r
getCtx Context start altDoc a -> T VarNum Rule
forall start altDoc a. Context start altDoc a -> T VarNum Rule
ctxOriginalRules
            let r :: Rule
r = T VarNum Rule -> VarNum -> Rule
forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex T VarNum Rule
rules VarNum
v
            VarNum -> Rule -> Pipeline start altDoc a (T (Bool, StateNum))
forall start altDoc a.
VarNum -> Rule -> Pipeline start altDoc a (T (Bool, StateNum))
laPegRulePipeline VarNum
v Rule
r

laPegRulePipeline
    :: LAPEG.VarNum -> LAPEG.Rule
    -> Pipeline start altDoc a (SymbolicIntMap.T (Bool, SRB.StateNum))
laPegRulePipeline :: VarNum -> Rule -> Pipeline start altDoc a (T (Bool, StateNum))
laPegRulePipeline VarNum
v Rule
r = do
    T (Bool, StateNum)
sm <- case Rule -> [AltNum]
LAPEG.ruleAlts Rule
r of
        [] ->
            T (Bool, StateNum) -> Pipeline start altDoc a (T (Bool, StateNum))
forall (f :: * -> *) a. Applicative f => a -> f a
pure T (Bool, StateNum)
forall a. IntMap a
SymbolicIntMap.empty
        AltNum
alt:[AltNum]
alts ->
            NonEmpty AltNum -> Pipeline start altDoc a (T (Bool, StateNum))
forall start altDoc a.
NonEmpty AltNum -> Pipeline start altDoc a (T (Bool, StateNum))
laPegEnterStatePipeline do AltNum
alt AltNum -> [AltNum] -> NonEmpty AltNum
forall a. a -> [a] -> NonEmpty a
:| [AltNum]
alts
    (Context start altDoc a -> Context start altDoc a)
-> StateT (Context start altDoc a) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \Context start altDoc a
ctx -> Context start altDoc a
ctx
        {
            $sel:ctxVarMap:Context :: T VarNum (T (Bool, StateNum))
ctxVarMap = VarNum
-> T (Bool, StateNum)
-> T VarNum (T (Bool, StateNum))
-> T VarNum (T (Bool, StateNum))
forall n a. T n => n -> a -> Map n a -> Map n a
AlignableMap.insert VarNum
v T (Bool, StateNum)
sm
                do Context start altDoc a -> T VarNum (T (Bool, StateNum))
forall start altDoc a.
Context start altDoc a -> T VarNum (T (Bool, StateNum))
ctxVarMap Context start altDoc a
ctx
        }
    T (Bool, StateNum) -> Pipeline start altDoc a (T (Bool, StateNum))
forall (f :: * -> *) a. Applicative f => a -> f a
pure T (Bool, StateNum)
sm

laPegEnterStatePipeline
    :: NonEmpty LAPEG.AltNum
    -> Pipeline start altDoc a (SymbolicIntMap.T (Bool, SRB.StateNum))
laPegEnterStatePipeline :: NonEmpty AltNum -> Pipeline start altDoc a (T (Bool, StateNum))
laPegEnterStatePipeline = \NonEmpty AltNum
alts -> [NonEmpty AltNum] -> Pipeline start altDoc a (T (Bool, StateNum))
forall start altDoc a.
[NonEmpty AltNum]
-> StateT (Context start altDoc a) Identity (T (Bool, StateNum))
go do [NonEmpty AltNum] -> NonEmpty AltNum -> [NonEmpty AltNum]
forall a. [NonEmpty a] -> NonEmpty a -> [NonEmpty a]
revTails [] NonEmpty AltNum
alts where
    revTails :: [NonEmpty a] -> NonEmpty a -> [NonEmpty a]
revTails [NonEmpty a]
accs = \case
        alts :: NonEmpty a
alts@(a
_:|[]) ->
            NonEmpty a
altsNonEmpty a -> [NonEmpty a] -> [NonEmpty a]
forall a. a -> [a] -> [a]
:[NonEmpty a]
accs
        alts :: NonEmpty a
alts@(a
_:|a
alt1:[a]
rest) ->
            [NonEmpty a] -> NonEmpty a -> [NonEmpty a]
revTails
                do NonEmpty a
altsNonEmpty a -> [NonEmpty a] -> [NonEmpty a]
forall a. a -> [a] -> [a]
:[NonEmpty a]
accs
                do a
alt1 a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
rest

    go :: [NonEmpty AltNum]
-> StateT (Context start altDoc a) Identity (T (Bool, StateNum))
go [NonEmpty AltNum]
altss = do
        IntMap (NonEmpty AltNum)
m <- IntMap (NonEmpty AltNum)
-> [NonEmpty AltNum]
-> StateT
     (Context start altDoc a) Identity (IntMap (NonEmpty AltNum))
forall start altDoc a.
IntMap (NonEmpty AltNum)
-> [NonEmpty AltNum]
-> StateT
     (Context start altDoc a) Identity (IntMap (NonEmpty AltNum))
go1 IntMap (NonEmpty AltNum)
forall a. IntMap a
SymbolicIntMap.empty [NonEmpty AltNum]
altss
        (NonEmpty AltNum
 -> StateT (Context start altDoc a) Identity (Bool, StateNum))
-> IntMap (NonEmpty AltNum)
-> StateT (Context start altDoc a) Identity (T (Bool, StateNum))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
            do \NonEmpty AltNum
alts -> do
                Bool
needBack <- NonEmpty AltNum -> Pipeline start altDoc a Bool
forall start altDoc a.
NonEmpty AltNum -> Pipeline start altDoc a Bool
isNeedBackAlts NonEmpty AltNum
alts
                StateNum
sn <- Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
forall start altDoc a.
Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
getStateForAltItems Position
forall i. Alignable i => i
Alignable.initialAlign NonEmpty AltNum
alts
                (Bool, StateNum)
-> StateT (Context start altDoc a) Identity (Bool, StateNum)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
needBack, StateNum
sn)
            do IntMap (NonEmpty AltNum)
m

    go1 :: IntMap (NonEmpty AltNum)
-> [NonEmpty AltNum]
-> StateT
     (Context start altDoc a) Identity (IntMap (NonEmpty AltNum))
go1 IntMap (NonEmpty AltNum)
m = \case
        [] ->
            IntMap (NonEmpty AltNum)
-> StateT
     (Context start altDoc a) Identity (IntMap (NonEmpty AltNum))
forall (f :: * -> *) a. Applicative f => a -> f a
pure IntMap (NonEmpty AltNum)
m
        alts :: NonEmpty AltNum
alts@(AltNum
altn :| [AltNum]
_):[NonEmpty AltNum]
rest -> do
            Maybe (T, Unit)
mru <- Position -> AltNum -> Pipeline start altDoc a (Maybe (T, Unit))
forall start altDoc a.
Position -> AltNum -> Pipeline start altDoc a (Maybe (T, Unit))
getUnitForAltItem Position
forall i. Alignable i => i
Alignable.initialAlign AltNum
altn
            let s :: T
s = case Maybe (T, Unit)
mru of
                    Maybe (T, Unit)
Nothing ->
                        T
SymbolicIntSet.full
                    Just (T
is, Unit
_) ->
                        T
is
            IntMap (NonEmpty AltNum)
-> [NonEmpty AltNum]
-> StateT
     (Context start altDoc a) Identity (IntMap (NonEmpty AltNum))
go1
                do T
-> NonEmpty AltNum
-> IntMap (NonEmpty AltNum)
-> IntMap (NonEmpty AltNum)
forall a. T -> a -> IntMap a -> IntMap a
SymbolicIntMap.insertBulk T
s NonEmpty AltNum
alts IntMap (NonEmpty AltNum)
m
                do [NonEmpty AltNum]
rest

laPegStatePipeline
    :: SRB.StateNum -> LAPEG.Position -> NonEmpty LAPEG.AltNum
    -> Pipeline start altDoc a ()
laPegStatePipeline :: StateNum
-> Position -> NonEmpty AltNum -> Pipeline start altDoc a ()
laPegStatePipeline StateNum
sn Position
p NonEmpty AltNum
alts = do
        T Trans
trans <- Position -> NonEmpty AltNum -> Pipeline start altDoc a (T Trans)
forall start altDoc a.
Position -> NonEmpty AltNum -> Pipeline start altDoc a (T Trans)
laPegTransPipeline Position
p NonEmpty AltNum
alts
        let st :: MState
st = MState :: StateNum -> T Trans -> [AltItem] -> MState
SRB.MState
                { $sel:stateNum:MState :: StateNum
stateNum = StateNum
sn
                , $sel:stateTrans:MState :: T Trans
stateTrans = T Trans
trans
                , $sel:stateAltItems:MState :: [AltItem]
stateAltItems = case NonEmpty AltNum
alts of
                    AltNum
alt :| [AltNum]
alts' -> AltNum -> AltItem
toAltItem AltNum
altAltItem -> [AltItem] -> [AltItem]
forall a. a -> [a] -> [a]
:[AltNum -> AltItem
toAltItem AltNum
alt' | AltNum
alt' <- [AltNum]
alts']
                }
        T start a Identity () -> Pipeline start altDoc a ()
forall start a r altDoc.
T start a Identity r -> Pipeline start altDoc a r
liftBuilder do MState -> T start a Identity ()
forall k (m :: * -> *) s (a :: k).
Monad m =>
MState -> BuilderT s a m ()
SRBBuilder.addState MState
st
    where
        toAltItem :: AltNum -> AltItem
toAltItem AltNum
altn = AltItem :: AltNum -> Position -> AltItem
SRB.AltItem
            {
                $sel:altItemAltNum:AltItem :: AltNum
altItemAltNum = AltNum
altn,
                $sel:altItemCurPos:AltItem :: Position
altItemCurPos = Position
p
            }

laPegTransPipeline
    :: LAPEG.Position -> NonEmpty LAPEG.AltNum
    -> Pipeline start altDoc a (SymbolicIntMap.T SRB.Trans)
laPegTransPipeline :: Position -> NonEmpty AltNum -> Pipeline start altDoc a (T Trans)
laPegTransPipeline Position
p0 NonEmpty AltNum
alts0 = do
        T AltItemsForTrans
m <- Position
-> NonEmpty AltNum -> Pipeline start altDoc a (T AltItemsForTrans)
forall start altDoc a.
Position
-> NonEmpty AltNum -> Pipeline start altDoc a (T AltItemsForTrans)
genAltMapForTrans Position
p0 NonEmpty AltNum
alts0
        let p1 :: Position
p1 = Position -> Position
forall i. Alignable i => i -> i
Alignable.nextAlign Position
p0
        (AltItemsForTrans
 -> StateT (Context start altDoc a) Identity Trans)
-> T AltItemsForTrans -> Pipeline start altDoc a (T Trans)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
            do \AltItemsForTrans
altItems -> Position
-> AltItemsForTrans
-> StateT (Context start altDoc a) Identity Trans
toTrans Position
p1 AltItemsForTrans
altItems
            do T AltItemsForTrans
m
    where
        toTrans :: Position
-> AltItemsForTrans
-> StateT (Context start altDoc a) Identity Trans
toTrans Position
p1 AltItemsForTrans
altItems = do
            Maybe TransOp
mbackOp <- case AltItemsForTrans -> [AltNum]
altItemsForTransRest AltItemsForTrans
altItems of
                [] ->
                    Maybe TransOp
-> StateT (Context start altDoc a) Identity (Maybe TransOp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TransOp
forall a. Maybe a
Nothing
                AltNum
ralt:[AltNum]
ralts -> do
                    StateNum
sn <- Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
forall start altDoc a.
Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
getStateForAltItems Position
p0 do AltNum
ralt AltNum -> [AltNum] -> NonEmpty AltNum
forall a. a -> [a] -> NonEmpty a
:| [AltNum]
ralts
                    Maybe TransOp
-> StateT (Context start altDoc a) Identity (Maybe TransOp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure do TransOp -> Maybe TransOp
forall a. a -> Maybe a
Just do StateNum -> TransOp
SRB.TransOpPushBackpoint StateNum
sn
            let withBackOp :: [TransOp] -> [TransOp]
withBackOp [TransOp]
ops = case Maybe TransOp
mbackOp of
                    Maybe TransOp
Nothing ->
                        [TransOp]
ops
                    Just TransOp
backOp ->
                        TransOp
backOpTransOp -> [TransOp] -> [TransOp]
forall a. a -> [a] -> [a]
:[TransOp]
ops
            case AltItemsForTrans -> AltItemsOpForTrans
altItemsForTransOp AltItemsForTrans
altItems of
                AltItemsOpForTrans
AltItemsOpShift -> do
                    let alts :: NonEmpty AltNum
alts = NonEmpty AltNum -> NonEmpty AltNum
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse do AltItemsForTrans -> NonEmpty AltNum
altItemsForTransRevAlts AltItemsForTrans
altItems
                    StateNum
sn <- Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
forall start altDoc a.
Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
getStateForAltItems Position
p1 NonEmpty AltNum
alts
                    Trans -> StateT (Context start altDoc a) Identity Trans
forall (f :: * -> *) a. Applicative f => a -> f a
pure do
                        [TransOp] -> StateNum -> Trans
SRB.TransWithOps
                            do [TransOp] -> [TransOp]
withBackOp [TransOp
SRB.TransOpShift]
                            do StateNum
sn
                AltItemsOpEnter VarNum
v Bool
needBack StateNum
enterSn -> do
                    let alts :: NonEmpty AltNum
alts = NonEmpty AltNum -> NonEmpty AltNum
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse do AltItemsForTrans -> NonEmpty AltNum
altItemsForTransRevAlts AltItemsForTrans
altItems
                    StateNum
sn <- Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
forall start altDoc a.
Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
getStateForAltItems Position
p1 NonEmpty AltNum
alts
                    Trans -> StateT (Context start altDoc a) Identity Trans
forall (f :: * -> *) a. Applicative f => a -> f a
pure do
                        [TransOp] -> StateNum -> Trans
SRB.TransWithOps
                            do [TransOp] -> [TransOp]
withBackOp [VarNum -> Bool -> Maybe StateNum -> TransOp
SRB.TransOpEnter VarNum
v Bool
needBack do StateNum -> Maybe StateNum
forall a. a -> Maybe a
Just StateNum
sn]
                            do StateNum
enterSn
                AltItemsOpForTrans
AltItemsOpNot -> do
                    let alts :: NonEmpty AltNum
alts = NonEmpty AltNum -> NonEmpty AltNum
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse do AltItemsForTrans -> NonEmpty AltNum
altItemsForTransRevAlts AltItemsForTrans
altItems
                    StateNum
sn <- Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
forall start altDoc a.
Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
getStateForAltItems Position
p1 NonEmpty AltNum
alts
                    let notAlt :: AltNum
notAlt = NonEmpty AltNum -> AltNum
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty AltNum
alts
                    Trans -> StateT (Context start altDoc a) Identity Trans
forall (f :: * -> *) a. Applicative f => a -> f a
pure do
                        [TransOp] -> StateNum -> Trans
SRB.TransWithOps
                            do [TransOp] -> [TransOp]
withBackOp [AltNum -> TransOp
SRB.TransOpHandleNot AltNum
notAlt]
                            do StateNum
sn
                AltItemsOpForTrans
AltItemsOpReduce -> do
                    let altn :: AltNum
altn = NonEmpty AltNum -> AltNum
forall a. NonEmpty a -> a
NonEmpty.last do AltItemsForTrans -> NonEmpty AltNum
altItemsForTransRevAlts AltItemsForTrans
altItems
                    Trans -> StateT (Context start altDoc a) Identity Trans
forall (f :: * -> *) a. Applicative f => a -> f a
pure do AltNum -> Trans
SRB.TransReduce AltNum
altn

genAltMapForTrans
    :: LAPEG.Position -> NonEmpty LAPEG.AltNum
    -> Pipeline start altDoc a (SymbolicIntMap.T AltItemsForTrans)
genAltMapForTrans :: Position
-> NonEmpty AltNum -> Pipeline start altDoc a (T AltItemsForTrans)
genAltMapForTrans Position
p (AltNum
alt0 :| [AltNum]
alts0) = T AltItemsForTrans
-> [AltNum] -> Pipeline start altDoc a (T AltItemsForTrans)
go T AltItemsForTrans
forall a. IntMap a
SymbolicIntMap.empty do AltNum
alt0AltNum -> [AltNum] -> [AltNum]
forall a. a -> [a] -> [a]
:[AltNum]
alts0 where
    go :: T AltItemsForTrans
-> [AltNum] -> Pipeline start altDoc a (T AltItemsForTrans)
go T AltItemsForTrans
m0 = \case
        [] ->
            T AltItemsForTrans -> Pipeline start altDoc a (T AltItemsForTrans)
forall (f :: * -> *) a. Applicative f => a -> f a
pure T AltItemsForTrans
m0
        AltNum
alt:[AltNum]
rest -> do
            T AltItemsForTrans
m1 <- T AltItemsForTrans
-> AltNum
-> [AltNum]
-> Pipeline start altDoc a (T AltItemsForTrans)
goAlt T AltItemsForTrans
m0 AltNum
alt [AltNum]
rest
            T AltItemsForTrans
-> [AltNum] -> Pipeline start altDoc a (T AltItemsForTrans)
go T AltItemsForTrans
m1 [AltNum]
rest

    goAlt :: T AltItemsForTrans
-> AltNum
-> [AltNum]
-> Pipeline start altDoc a (T AltItemsForTrans)
goAlt T AltItemsForTrans
m0 AltNum
alt [AltNum]
rest = Position -> AltNum -> Pipeline start altDoc a (Maybe (T, Unit))
forall start altDoc a.
Position -> AltNum -> Pipeline start altDoc a (Maybe (T, Unit))
getUnitForAltItem Position
p AltNum
alt Pipeline start altDoc a (Maybe (T, Unit))
-> (Maybe (T, Unit)
    -> Pipeline start altDoc a (T AltItemsForTrans))
-> Pipeline start altDoc a (T AltItemsForTrans)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (T, Unit)
Nothing -> do
            let m1 :: T AltItemsForTrans
m1 = (Maybe AltItemsForTrans -> Maybe AltItemsForTrans)
-> T -> T AltItemsForTrans -> T AltItemsForTrans
forall a. (Maybe a -> Maybe a) -> T -> IntMap a -> IntMap a
SymbolicIntMap.alterBulk
                    do \case
                        e :: Maybe AltItemsForTrans
e@(Just AltItemsForTrans
altItems) | AltItemsForTrans -> Bool
hasRest AltItemsForTrans
altItems ->
                            Maybe AltItemsForTrans
e
                        Just AltItemsForTrans
altItems -> AltItemsForTrans -> Maybe AltItemsForTrans
forall a. a -> Maybe a
Just do
                            AltItemsForTrans
altItems
                                {
                                    $sel:altItemsForTransRest:AltMapForTrans :: [AltNum]
altItemsForTransRest = AltNum
altAltNum -> [AltNum] -> [AltNum]
forall a. a -> [a] -> [a]
:[AltNum]
rest
                                }
                        Maybe AltItemsForTrans
Nothing -> AltItemsForTrans -> Maybe AltItemsForTrans
forall a. a -> Maybe a
Just do
                            AltMapForTrans :: AltItemsOpForTrans
-> NonEmpty AltNum -> [AltNum] -> AltItemsForTrans
AltMapForTrans
                                { $sel:altItemsForTransOp:AltMapForTrans :: AltItemsOpForTrans
altItemsForTransOp = AltItemsOpForTrans
AltItemsOpReduce
                                , $sel:altItemsForTransRevAlts:AltMapForTrans :: NonEmpty AltNum
altItemsForTransRevAlts = AltNum -> NonEmpty AltNum
forall (f :: * -> *) a. Applicative f => a -> f a
pure AltNum
alt
                                , $sel:altItemsForTransRest:AltMapForTrans :: [AltNum]
altItemsForTransRest = []
                                }
                    do T
SymbolicIntSet.full
                    do T AltItemsForTrans
m0
            T AltItemsForTrans -> Pipeline start altDoc a (T AltItemsForTrans)
forall (f :: * -> *) a. Applicative f => a -> f a
pure T AltItemsForTrans
m1
        Just (T
_, LAPEG.UnitTerminal Terminal
t) -> do
            let m1 :: T AltItemsForTrans
m1 = (Maybe AltItemsForTrans -> Maybe AltItemsForTrans)
-> Terminal -> T AltItemsForTrans -> T AltItemsForTrans
forall a. (Maybe a -> Maybe a) -> Terminal -> IntMap a -> IntMap a
SymbolicIntMap.alter
                    do \case
                        e :: Maybe AltItemsForTrans
e@(Just AltItemsForTrans
altItems) | AltItemsForTrans -> Bool
hasRest AltItemsForTrans
altItems ->
                            Maybe AltItemsForTrans
e
                        Just AltItemsForTrans
altItems -> case AltItemsForTrans -> AltItemsOpForTrans
altItemsForTransOp AltItemsForTrans
altItems of
                            AltItemsOpForTrans
AltItemsOpShift -> AltItemsForTrans -> Maybe AltItemsForTrans
forall a. a -> Maybe a
Just do
                                AltItemsForTrans
altItems
                                    {
                                        $sel:altItemsForTransRevAlts:AltMapForTrans :: NonEmpty AltNum
altItemsForTransRevAlts = AltNum -> NonEmpty AltNum -> NonEmpty AltNum
forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.cons AltNum
alt
                                            do AltItemsForTrans -> NonEmpty AltNum
altItemsForTransRevAlts AltItemsForTrans
altItems
                                    }
                            AltItemsOpForTrans
_ -> AltItemsForTrans -> Maybe AltItemsForTrans
forall a. a -> Maybe a
Just do
                                AltItemsForTrans
altItems
                                    {
                                        $sel:altItemsForTransRest:AltMapForTrans :: [AltNum]
altItemsForTransRest = AltNum
altAltNum -> [AltNum] -> [AltNum]
forall a. a -> [a] -> [a]
:[AltNum]
rest
                                    }
                        Maybe AltItemsForTrans
Nothing -> AltItemsForTrans -> Maybe AltItemsForTrans
forall a. a -> Maybe a
Just do
                            AltMapForTrans :: AltItemsOpForTrans
-> NonEmpty AltNum -> [AltNum] -> AltItemsForTrans
AltMapForTrans
                                { $sel:altItemsForTransOp:AltMapForTrans :: AltItemsOpForTrans
altItemsForTransOp = AltItemsOpForTrans
AltItemsOpShift
                                , $sel:altItemsForTransRevAlts:AltMapForTrans :: NonEmpty AltNum
altItemsForTransRevAlts = AltNum -> NonEmpty AltNum
forall (f :: * -> *) a. Applicative f => a -> f a
pure AltNum
alt
                                , $sel:altItemsForTransRest:AltMapForTrans :: [AltNum]
altItemsForTransRest = []
                                }
                    do Terminal
t
                    do T AltItemsForTrans
m0
            T AltItemsForTrans -> Pipeline start altDoc a (T AltItemsForTrans)
forall (f :: * -> *) a. Applicative f => a -> f a
pure T AltItemsForTrans
m1
        Just (T
is, LAPEG.UnitNonTerminal VarNum
v) -> do
            T (Bool, StateNum)
vm <- VarNum -> Pipeline start altDoc a (T (Bool, StateNum))
forall start altDoc a.
VarNum -> Pipeline start altDoc a (T (Bool, StateNum))
laPegVarPipeline VarNum
v
            let m1 :: T AltItemsForTrans
m1 = (AltItemsForTrans -> (Bool, StateNum) -> Maybe AltItemsForTrans)
-> (AltItemsForTrans -> Maybe AltItemsForTrans)
-> ((Bool, StateNum) -> Maybe AltItemsForTrans)
-> T AltItemsForTrans
-> T (Bool, StateNum)
-> T AltItemsForTrans
forall a b c.
(a -> b -> Maybe c)
-> (a -> Maybe c)
-> (b -> Maybe c)
-> IntMap a
-> IntMap b
-> IntMap c
SymbolicIntMap.merge
                    do \AltItemsForTrans
altItems (Bool
needBack, StateNum
sn) -> case AltItemsForTrans -> AltItemsOpForTrans
altItemsForTransOp AltItemsForTrans
altItems of
                        AltItemsOpForTrans
_ | AltItemsForTrans -> Bool
hasRest AltItemsForTrans
altItems ->
                            AltItemsForTrans -> Maybe AltItemsForTrans
forall a. a -> Maybe a
Just AltItemsForTrans
altItems
                        transOp :: AltItemsOpForTrans
transOp@AltItemsOpEnter{} | AltItemsOpForTrans
transOp AltItemsOpForTrans -> AltItemsOpForTrans -> Bool
forall a. Eq a => a -> a -> Bool
== VarNum -> Bool -> StateNum -> AltItemsOpForTrans
AltItemsOpEnter VarNum
v Bool
needBack StateNum
sn ->
                            AltItemsForTrans -> Maybe AltItemsForTrans
forall a. a -> Maybe a
Just do
                                AltItemsForTrans
altItems
                                    {
                                        $sel:altItemsForTransRevAlts:AltMapForTrans :: NonEmpty AltNum
altItemsForTransRevAlts = AltNum -> NonEmpty AltNum -> NonEmpty AltNum
forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.cons AltNum
alt
                                            do AltItemsForTrans -> NonEmpty AltNum
altItemsForTransRevAlts AltItemsForTrans
altItems
                                    }
                        AltItemsOpForTrans
_ -> AltItemsForTrans -> Maybe AltItemsForTrans
forall a. a -> Maybe a
Just do
                            AltItemsForTrans
altItems
                                {
                                    $sel:altItemsForTransRest:AltMapForTrans :: [AltNum]
altItemsForTransRest = AltNum
altAltNum -> [AltNum] -> [AltNum]
forall a. a -> [a] -> [a]
:[AltNum]
rest
                                }
                    do \AltItemsForTrans
altItems -> AltItemsForTrans -> Maybe AltItemsForTrans
forall a. a -> Maybe a
Just AltItemsForTrans
altItems
                    do \(Bool
needBack, StateNum
sn) -> AltItemsForTrans -> Maybe AltItemsForTrans
forall a. a -> Maybe a
Just do
                        AltMapForTrans :: AltItemsOpForTrans
-> NonEmpty AltNum -> [AltNum] -> AltItemsForTrans
AltMapForTrans
                            { $sel:altItemsForTransOp:AltMapForTrans :: AltItemsOpForTrans
altItemsForTransOp = VarNum -> Bool -> StateNum -> AltItemsOpForTrans
AltItemsOpEnter VarNum
v Bool
needBack StateNum
sn
                            , $sel:altItemsForTransRevAlts:AltMapForTrans :: NonEmpty AltNum
altItemsForTransRevAlts = AltNum -> NonEmpty AltNum
forall (f :: * -> *) a. Applicative f => a -> f a
pure AltNum
alt
                            , $sel:altItemsForTransRest:AltMapForTrans :: [AltNum]
altItemsForTransRest = []
                            }
                    do T AltItemsForTrans
m0
                    do T (Bool, StateNum) -> T -> T (Bool, StateNum)
forall a. IntMap a -> T -> IntMap a
SymbolicIntMap.restrictKeys T (Bool, StateNum)
vm T
is
            T AltItemsForTrans -> Pipeline start altDoc a (T AltItemsForTrans)
forall (f :: * -> *) a. Applicative f => a -> f a
pure T AltItemsForTrans
m1
        Just (T
is, Unit
LAPEG.UnitNot) -> do
            let m1 :: T AltItemsForTrans
m1 = (Maybe AltItemsForTrans -> Maybe AltItemsForTrans)
-> T -> T AltItemsForTrans -> T AltItemsForTrans
forall a. (Maybe a -> Maybe a) -> T -> IntMap a -> IntMap a
SymbolicIntMap.alterBulk
                    do \case
                        e :: Maybe AltItemsForTrans
e@(Just AltItemsForTrans
altItems) | AltItemsForTrans -> Bool
hasRest AltItemsForTrans
altItems ->
                            Maybe AltItemsForTrans
e
                        Just AltItemsForTrans
altItems -> AltItemsForTrans -> Maybe AltItemsForTrans
forall a. a -> Maybe a
Just do
                            AltItemsForTrans
altItems
                                {
                                    $sel:altItemsForTransRest:AltMapForTrans :: [AltNum]
altItemsForTransRest = AltNum
altAltNum -> [AltNum] -> [AltNum]
forall a. a -> [a] -> [a]
:[AltNum]
rest
                                }
                        Maybe AltItemsForTrans
Nothing -> AltItemsForTrans -> Maybe AltItemsForTrans
forall a. a -> Maybe a
Just do
                            AltMapForTrans :: AltItemsOpForTrans
-> NonEmpty AltNum -> [AltNum] -> AltItemsForTrans
AltMapForTrans
                                { $sel:altItemsForTransOp:AltMapForTrans :: AltItemsOpForTrans
altItemsForTransOp = AltItemsOpForTrans
AltItemsOpNot
                                , $sel:altItemsForTransRevAlts:AltMapForTrans :: NonEmpty AltNum
altItemsForTransRevAlts = AltNum -> NonEmpty AltNum
forall (f :: * -> *) a. Applicative f => a -> f a
pure AltNum
alt
                                , $sel:altItemsForTransRest:AltMapForTrans :: [AltNum]
altItemsForTransRest = [AltNum]
rest
                                }
                    do T
is
                    do T AltItemsForTrans
m0
            T AltItemsForTrans -> Pipeline start altDoc a (T AltItemsForTrans)
forall (f :: * -> *) a. Applicative f => a -> f a
pure T AltItemsForTrans
m1

    hasRest :: AltItemsForTrans -> Bool
hasRest AltItemsForTrans
altItems = Bool -> Bool
not do [AltNum] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null do AltItemsForTrans -> [AltNum]
altItemsForTransRest AltItemsForTrans
altItems

data AltItemsForTrans = AltMapForTrans
    {
        AltItemsForTrans -> AltItemsOpForTrans
altItemsForTransOp      :: AltItemsOpForTrans,
        AltItemsForTrans -> NonEmpty AltNum
altItemsForTransRevAlts :: NonEmpty LAPEG.AltNum,
        AltItemsForTrans -> [AltNum]
altItemsForTransRest    :: [LAPEG.AltNum]
    }
    deriving (AltItemsForTrans -> AltItemsForTrans -> Bool
(AltItemsForTrans -> AltItemsForTrans -> Bool)
-> (AltItemsForTrans -> AltItemsForTrans -> Bool)
-> Eq AltItemsForTrans
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AltItemsForTrans -> AltItemsForTrans -> Bool
$c/= :: AltItemsForTrans -> AltItemsForTrans -> Bool
== :: AltItemsForTrans -> AltItemsForTrans -> Bool
$c== :: AltItemsForTrans -> AltItemsForTrans -> Bool
Eq, Terminal -> AltItemsForTrans -> ShowS
[AltItemsForTrans] -> ShowS
AltItemsForTrans -> String
(Terminal -> AltItemsForTrans -> ShowS)
-> (AltItemsForTrans -> String)
-> ([AltItemsForTrans] -> ShowS)
-> Show AltItemsForTrans
forall a.
(Terminal -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AltItemsForTrans] -> ShowS
$cshowList :: [AltItemsForTrans] -> ShowS
show :: AltItemsForTrans -> String
$cshow :: AltItemsForTrans -> String
showsPrec :: Terminal -> AltItemsForTrans -> ShowS
$cshowsPrec :: Terminal -> AltItemsForTrans -> ShowS
Show)

data AltItemsOpForTrans
    = AltItemsOpShift
    | AltItemsOpEnter LAPEG.VarNum Bool SRB.StateNum
    | AltItemsOpNot
    | AltItemsOpReduce
    deriving (AltItemsOpForTrans -> AltItemsOpForTrans -> Bool
(AltItemsOpForTrans -> AltItemsOpForTrans -> Bool)
-> (AltItemsOpForTrans -> AltItemsOpForTrans -> Bool)
-> Eq AltItemsOpForTrans
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AltItemsOpForTrans -> AltItemsOpForTrans -> Bool
$c/= :: AltItemsOpForTrans -> AltItemsOpForTrans -> Bool
== :: AltItemsOpForTrans -> AltItemsOpForTrans -> Bool
$c== :: AltItemsOpForTrans -> AltItemsOpForTrans -> Bool
Eq, Terminal -> AltItemsOpForTrans -> ShowS
[AltItemsOpForTrans] -> ShowS
AltItemsOpForTrans -> String
(Terminal -> AltItemsOpForTrans -> ShowS)
-> (AltItemsOpForTrans -> String)
-> ([AltItemsOpForTrans] -> ShowS)
-> Show AltItemsOpForTrans
forall a.
(Terminal -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AltItemsOpForTrans] -> ShowS
$cshowList :: [AltItemsOpForTrans] -> ShowS
show :: AltItemsOpForTrans -> String
$cshow :: AltItemsOpForTrans -> String
showsPrec :: Terminal -> AltItemsOpForTrans -> ShowS
$cshowsPrec :: Terminal -> AltItemsOpForTrans -> ShowS
Show)

getStateForAltItems
    :: LAPEG.Position -> NonEmpty LAPEG.AltNum
    -> Pipeline start altDoc a SRB.StateNum
getStateForAltItems :: Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
getStateForAltItems Position
p NonEmpty AltNum
alts = do
    HashMap (Position, NonEmpty AltNum) StateNum
m <- (Context start altDoc a
 -> HashMap (Position, NonEmpty AltNum) StateNum)
-> Pipeline
     start altDoc a (HashMap (Position, NonEmpty AltNum) StateNum)
forall start altDoc a r.
(Context start altDoc a -> r) -> Pipeline start altDoc a r
getCtx Context start altDoc a
-> HashMap (Position, NonEmpty AltNum) StateNum
forall start altDoc a.
Context start altDoc a
-> HashMap (Position, NonEmpty AltNum) StateNum
ctxStateMap
    case (Position, NonEmpty AltNum)
-> HashMap (Position, NonEmpty AltNum) StateNum -> Maybe StateNum
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Position
p, NonEmpty AltNum
alts) HashMap (Position, NonEmpty AltNum) StateNum
m of
        Just StateNum
sn ->
            StateNum -> Pipeline start altDoc a StateNum
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateNum
sn
        Maybe StateNum
Nothing -> do
            StateNum
sn <- T start a Identity StateNum -> Pipeline start altDoc a StateNum
forall start a r altDoc.
T start a Identity r -> Pipeline start altDoc a r
liftBuilder T start a Identity StateNum
forall k (m :: * -> *) start (a :: k).
Monad m =>
BuilderT start a m StateNum
SRBBuilder.genNewStateNum
            (Context start altDoc a -> Context start altDoc a)
-> StateT (Context start altDoc a) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \Context start altDoc a
ctx -> Context start altDoc a
ctx
                { $sel:ctxStateMap:Context :: HashMap (Position, NonEmpty AltNum) StateNum
ctxStateMap = (Position, NonEmpty AltNum)
-> StateNum
-> HashMap (Position, NonEmpty AltNum) StateNum
-> HashMap (Position, NonEmpty AltNum) StateNum
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert (Position
p, NonEmpty AltNum
alts) StateNum
sn
                    do Context start altDoc a
-> HashMap (Position, NonEmpty AltNum) StateNum
forall start altDoc a.
Context start altDoc a
-> HashMap (Position, NonEmpty AltNum) StateNum
ctxStateMap Context start altDoc a
ctx
                , $sel:ctxStateQueue:Context :: [(StateNum, Position, NonEmpty AltNum)]
ctxStateQueue = (StateNum
sn, Position
p, NonEmpty AltNum
alts)(StateNum, Position, NonEmpty AltNum)
-> [(StateNum, Position, NonEmpty AltNum)]
-> [(StateNum, Position, NonEmpty AltNum)]
forall a. a -> [a] -> [a]
:Context start altDoc a -> [(StateNum, Position, NonEmpty AltNum)]
forall start altDoc a.
Context start altDoc a -> [(StateNum, Position, NonEmpty AltNum)]
ctxStateQueue Context start altDoc a
ctx
                }
            StateNum -> Pipeline start altDoc a StateNum
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateNum
sn

isNeedBackAlts :: NonEmpty LAPEG.AltNum -> Pipeline start altDoc a Bool
isNeedBackAlts :: NonEmpty AltNum -> Pipeline start altDoc a Bool
isNeedBackAlts = \(AltNum
altn :| [AltNum]
rest) -> AltNum -> [AltNum] -> Pipeline start altDoc a Bool
forall start altDoc a.
AltNum -> [AltNum] -> StateT (Context start altDoc a) Identity Bool
go AltNum
altn [AltNum]
rest where
    go :: AltNum -> [AltNum] -> StateT (Context start altDoc a) Identity Bool
go AltNum
altn0 [AltNum]
rest = do
        Alt altDoc a
alt0 <- AltNum -> Pipeline start altDoc a (Alt altDoc a)
forall start altDoc a.
AltNum -> Pipeline start altDoc a (Alt altDoc a)
getAlt AltNum
altn0
        case Alt altDoc a -> AltKind
forall altDoc a. Alt altDoc a -> AltKind
LAPEG.altKind Alt altDoc a
alt0 of
            AltKind
PEG.AltNot ->
                Bool -> StateT (Context start altDoc a) Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            AltKind
PEG.AltAnd ->
                Bool -> StateT (Context start altDoc a) Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            AltKind
PEG.AltSeq -> case [AltNum]
rest of
                [] ->
                    Bool -> StateT (Context start altDoc a) Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
                AltNum
altn1:[AltNum]
alts ->
                    AltNum -> [AltNum] -> StateT (Context start altDoc a) Identity Bool
go AltNum
altn1 [AltNum]
alts

getUnitForAltItem
    :: LAPEG.Position -> LAPEG.AltNum
    -> Pipeline start altDoc a (Maybe (SymbolicIntSet.T, LAPEG.Unit))
getUnitForAltItem :: Position -> AltNum -> Pipeline start altDoc a (Maybe (T, Unit))
getUnitForAltItem Position
p AltNum
altn = do
    Alt altDoc a
alt <- AltNum -> Pipeline start altDoc a (Alt altDoc a)
forall start altDoc a.
AltNum -> Pipeline start altDoc a (Alt altDoc a)
getAlt AltNum
altn
    let us :: T Position (HeadRange, Unit)
us = Alt altDoc a -> T Position (HeadRange, Unit)
forall altDoc a. Alt altDoc a -> T Position (HeadRange, Unit)
LAPEG.altUnitSeqWithLookAHead Alt altDoc a
alt
    case T Position (HeadRange, Unit) -> Position -> Maybe (HeadRange, Unit)
forall n a. T n => Array n a -> n -> Maybe a
AlignableArray.index T Position (HeadRange, Unit)
us Position
p of
        Maybe (HeadRange, Unit)
Nothing ->
            Maybe (T, Unit) -> Pipeline start altDoc a (Maybe (T, Unit))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (T, Unit)
forall a. Maybe a
Nothing
        Just (HeadRange
hr, Unit
u) -> do
            let is :: T
is = if HeadRange -> Bool
LAPEG.headRangeEpsilon HeadRange
hr
                    then T
SymbolicIntSet.full
                    else HeadRange -> T
LAPEG.headRangeConsume HeadRange
hr
            Maybe (T, Unit) -> Pipeline start altDoc a (Maybe (T, Unit))
forall (f :: * -> *) a. Applicative f => a -> f a
pure do (T, Unit) -> Maybe (T, Unit)
forall a. a -> Maybe a
Just (T
is, Unit
u)

getAlt :: LAPEG.AltNum -> Pipeline start altDoc a (LAPEG.Alt altDoc a)
getAlt :: AltNum -> Pipeline start altDoc a (Alt altDoc a)
getAlt AltNum
altn = do
    T AltNum (Alt altDoc a)
alts <- (Context start altDoc a -> T AltNum (Alt altDoc a))
-> Pipeline start altDoc a (T AltNum (Alt altDoc a))
forall start altDoc a r.
(Context start altDoc a -> r) -> Pipeline start altDoc a r
getCtx Context start altDoc a -> T AltNum (Alt altDoc a)
forall start altDoc a.
Context start altDoc a -> T AltNum (Alt altDoc a)
ctxOriginalAlts
    let alt :: Alt altDoc a
alt = 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)
alts AltNum
altn
    Alt altDoc a -> Pipeline start altDoc a (Alt altDoc a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alt altDoc a
alt

getCtx :: (Context start altDoc a -> r) -> Pipeline start altDoc a r
getCtx :: (Context start altDoc a -> r) -> Pipeline start altDoc a r
getCtx Context start altDoc a -> r
f = Context start altDoc a -> r
f (Context start altDoc a -> r)
-> StateT
     (Context start altDoc a) Identity (Context start altDoc a)
-> Pipeline start altDoc a r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (Context start altDoc a) Identity (Context start altDoc a)
forall (m :: * -> *) s. Monad m => StateT s m s
get

liftBuilder :: SRBBuilder.T start a Identity r -> Pipeline start altDoc a r
liftBuilder :: T start a Identity r -> Pipeline start altDoc a r
liftBuilder T start a Identity r
builder = do
    Context start altDoc a
ctx <- StateT (Context start altDoc a) Identity (Context start altDoc a)
forall (m :: * -> *) s. Monad m => StateT s m s
get
    let (r
x, Context start a
builderCtx) = Identity (r, Context start a) -> (r, Context start a)
forall a. Identity a -> a
runIdentity
            do T start a Identity r
-> Context start a -> Identity (r, Context start a)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT T start a Identity r
builder do Context start altDoc a -> Context start a
forall start altDoc a. Context start altDoc a -> Context start a
ctxBuilder Context start altDoc a
ctx
    Context start altDoc a
-> StateT (Context start altDoc a) Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do Context start altDoc a
ctx { $sel:ctxBuilder:Context :: Context start a
ctxBuilder = Context start a
builderCtx }
    r -> Pipeline start altDoc a r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
x