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 :: forall start varDoc altDoc a.
Enum start =>
T start varDoc altDoc a -> T start varDoc altDoc a
laPeg2Srb T start varDoc altDoc a
g = forall a. Identity a -> a
runIdentity do
        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 forall start varDoc altDoc a.
LAPEG start varDoc altDoc a -> T VarNum (Var varDoc)
LAPEG.vars T start varDoc altDoc a
g
            do 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 <- forall (m :: * -> *) s. Monad m => StateT s m s
get
            let initialCtx :: Context start altDoc a
initialCtx = Context
                    { $sel:ctxBuilder:Context :: Context start a
ctxBuilder = Context start a
initialBuilderCtx
                    , $sel:ctxInitialVarState:Context :: T VarNum StateNum
ctxInitialVarState = forall {k} (n :: k) a. Map n a
AlignableMap.empty
                    , $sel:ctxReduceNotState:Context :: T AltNum StateNum
ctxReduceNotState = forall {k} (n :: k) a. Map n a
AlignableMap.empty
                    , $sel:ctxVarMap:Context :: T VarNum (T (Bool, StateNum))
ctxVarMap = forall {k} (n :: k) a. Map n a
AlignableMap.empty
                    , $sel:ctxStateMap:Context :: HashMap (Position, NonEmpty AltNum) StateNum
ctxStateMap = forall k v. HashMap k v
HashMap.empty
                    , $sel:ctxStateQueue:Context :: [(StateNum, Position, NonEmpty AltNum)]
ctxStateQueue = []
                    , $sel:ctxOriginalRules:Context :: T VarNum Rule
ctxOriginalRules = 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 = 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 = forall s a. State s a -> s -> s
execState StateT (Context start altDoc a) Identity ()
pipeline Context start altDoc a
initialCtx
            forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do forall start altDoc a. Context start altDoc a -> Context start a
ctxBuilder Context start altDoc a
finalCtx

        pipeline :: StateT (Context start altDoc a) Identity ()
pipeline = do
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
                do forall k a. Enum k => EnumMap k a -> [(k, a)]
EnumMap.assocs do 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) -> forall start altDoc a.
Enum start =>
start -> VarNum -> Pipeline start altDoc a ()
laPegInitialPipeline start
s VarNum
v
            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
    { forall start altDoc a. Context start altDoc a -> Context start a
ctxBuilder :: SRBBuilder.Context start a
    , forall start altDoc a. Context start altDoc a -> T VarNum StateNum
ctxInitialVarState :: AlignableMap.T LAPEG.VarNum SRB.StateNum
    , forall start altDoc a. Context start altDoc a -> T AltNum StateNum
ctxReduceNotState :: AlignableMap.T LAPEG.AltNum SRB.StateNum
    , forall start altDoc a.
Context start altDoc a -> T VarNum (T (Bool, StateNum))
ctxVarMap  :: AlignableMap.T LAPEG.VarNum (SymbolicIntMap.T (Bool, SRB.StateNum))
    , forall start altDoc a.
Context start altDoc a
-> HashMap (Position, NonEmpty AltNum) StateNum
ctxStateMap :: HashMap.HashMap (LAPEG.Position, NonEmpty LAPEG.AltNum) SRB.StateNum
    , forall start altDoc a.
Context start altDoc a -> [(StateNum, Position, NonEmpty AltNum)]
ctxStateQueue :: [(SRB.StateNum, LAPEG.Position, NonEmpty LAPEG.AltNum)]
    , forall start altDoc a. Context start altDoc a -> T VarNum Rule
ctxOriginalRules :: AlignableArray.T LAPEG.VarNum LAPEG.Rule
    , forall start altDoc a.
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 :: forall start altDoc a.
Enum start =>
start -> VarNum -> Pipeline start altDoc a ()
laPegInitialPipeline start
s VarNum
v = do
    T VarNum StateNum
m0 <- forall start altDoc a r.
(Context start altDoc a -> r) -> Pipeline start altDoc a r
getCtx forall start altDoc a. Context start altDoc a -> T VarNum StateNum
ctxInitialVarState
    StateNum
newSn <- case forall n a. T n => n -> Map n a -> Maybe a
AlignableMap.lookup VarNum
v T VarNum StateNum
m0 of
        Just StateNum
sn ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure StateNum
sn
        Maybe StateNum
Nothing -> do
            StateNum
sn <- forall start a r altDoc.
T start a Identity r -> Pipeline start altDoc a r
liftBuilder do forall {k} (m :: * -> *) start (a :: k).
Monad m =>
BuilderT start a m StateNum
SRBBuilder.genNewStateNum
            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 = forall n a. T n => n -> a -> Map n a -> Map n a
AlignableMap.insert VarNum
v StateNum
sn
                        do forall start altDoc a. Context start altDoc a -> T VarNum StateNum
ctxInitialVarState Context start altDoc a
ctx
                }
            T (Bool, StateNum)
m <- forall start altDoc a.
VarNum -> Pipeline start altDoc a (T (Bool, StateNum))
laPegVarPipeline VarNum
v
            let st :: MState
st = SRB.MState
                    { $sel:stateNum:MState :: StateNum
stateNum = StateNum
sn
                    , $sel:stateTrans:MState :: T Trans
stateTrans = 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 forall a. Maybe a
Nothing] StateNum
to
                        do T (Bool, StateNum)
m
                    , $sel:stateAltItems:MState :: [AltItem]
stateAltItems = []
                    }
            forall start a r altDoc.
T start a Identity r -> Pipeline start altDoc a r
liftBuilder do forall {k} (m :: * -> *) s (a :: k).
Monad m =>
MState -> BuilderT s a m ()
SRBBuilder.addState MState
st
            forall (f :: * -> *) a. Applicative f => a -> f a
pure StateNum
sn
    forall start a r altDoc.
T start a Identity r -> Pipeline start altDoc a r
liftBuilder do 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 :: forall start altDoc a. Pipeline start altDoc a ()
laPegStateQueuePipeline = do
    Context start altDoc a
ctx <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    case forall start altDoc a.
Context start altDoc a -> [(StateNum, Position, NonEmpty AltNum)]
ctxStateQueue Context start altDoc a
ctx of
        [] ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        (StateNum
sn, Position
p, NonEmpty AltNum
alts):[(StateNum, Position, NonEmpty AltNum)]
rest -> do
            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 }
            forall start altDoc a.
StateNum
-> Position -> NonEmpty AltNum -> Pipeline start altDoc a ()
laPegStatePipeline StateNum
sn Position
p NonEmpty AltNum
alts
            forall start altDoc a. Pipeline start altDoc a ()
laPegStateQueuePipeline

laPegVarPipeline
    :: LAPEG.VarNum
    -> Pipeline start altDoc a (SymbolicIntMap.T (Bool, SRB.StateNum))
laPegVarPipeline :: forall start altDoc a.
VarNum -> Pipeline start altDoc a (T (Bool, StateNum))
laPegVarPipeline VarNum
v = do
    T VarNum (T (Bool, StateNum))
varMap <- forall start altDoc a r.
(Context start altDoc a -> r) -> Pipeline start altDoc a r
getCtx forall start altDoc a.
Context start altDoc a -> T VarNum (T (Bool, StateNum))
ctxVarMap
    case 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 ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure T (Bool, StateNum)
ss
        Maybe (T (Bool, StateNum))
Nothing -> do
            T VarNum Rule
rules <- forall start altDoc a r.
(Context start altDoc a -> r) -> Pipeline start altDoc a r
getCtx forall start altDoc a. Context start altDoc a -> T VarNum Rule
ctxOriginalRules
            let r :: Rule
r = forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex T VarNum Rule
rules VarNum
v
            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 :: forall start altDoc a.
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
        [] ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. IntMap a
SymbolicIntMap.empty
        AltNum
alt:[AltNum]
alts ->
            forall start altDoc a.
NonEmpty AltNum -> Pipeline start altDoc a (T (Bool, StateNum))
laPegEnterStatePipeline do AltNum
alt forall a. a -> [a] -> NonEmpty a
:| [AltNum]
alts
    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 = forall n a. T n => n -> a -> Map n a -> Map n a
AlignableMap.insert VarNum
v T (Bool, StateNum)
sm
                do forall start altDoc a.
Context start altDoc a -> T VarNum (T (Bool, StateNum))
ctxVarMap Context start altDoc a
ctx
        }
    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 :: forall start altDoc a.
NonEmpty AltNum -> Pipeline start altDoc a (T (Bool, StateNum))
laPegEnterStatePipeline = \NonEmpty AltNum
alts -> forall {start} {altDoc} {a}.
[NonEmpty AltNum]
-> StateT (Context start altDoc a) Identity (T (Bool, StateNum))
go do 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
altsforall 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
altsforall a. a -> [a] -> [a]
:[NonEmpty a]
accs
                do a
alt1 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 <- forall {start} {altDoc} {a}.
IntMap (NonEmpty AltNum)
-> [NonEmpty AltNum]
-> StateT
     (Context start altDoc a) Identity (IntMap (NonEmpty AltNum))
go1 forall a. IntMap a
SymbolicIntMap.empty [NonEmpty AltNum]
altss
        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 <- forall start altDoc a.
NonEmpty AltNum -> Pipeline start altDoc a Bool
isNeedBackAlts NonEmpty AltNum
alts
                StateNum
sn <- forall start altDoc a.
Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
getStateForAltItems forall i. Alignable i => i
Alignable.initialAlign NonEmpty AltNum
alts
                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
        [] ->
            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 <- forall start altDoc a.
Position -> AltNum -> Pipeline start altDoc a (Maybe (T, Unit))
getUnitForAltItem 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 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 :: forall start altDoc a.
StateNum
-> Position -> NonEmpty AltNum -> Pipeline start altDoc a ()
laPegStatePipeline StateNum
sn Position
p NonEmpty AltNum
alts = do
        T Trans
trans <- forall start altDoc a.
Position -> NonEmpty AltNum -> Pipeline start altDoc a (T Trans)
laPegTransPipeline Position
p NonEmpty AltNum
alts
        let st :: MState
st = 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
altforall a. a -> [a] -> [a]
:[AltNum -> AltItem
toAltItem AltNum
alt' | AltNum
alt' <- [AltNum]
alts']
                }
        forall start a r altDoc.
T start a Identity r -> Pipeline start altDoc a r
liftBuilder do forall {k} (m :: * -> *) s (a :: k).
Monad m =>
MState -> BuilderT s a m ()
SRBBuilder.addState MState
st
    where
        toAltItem :: AltNum -> AltItem
toAltItem AltNum
altn = 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 :: forall start altDoc a.
Position -> NonEmpty AltNum -> Pipeline start altDoc a (T Trans)
laPegTransPipeline Position
p0 NonEmpty AltNum
alts0 = do
        T AltItemsForTrans
m <- forall start altDoc a.
Position
-> NonEmpty AltNum -> Pipeline start altDoc a (T AltItemsForTrans)
genAltMapForTrans Position
p0 NonEmpty AltNum
alts0
        let p1 :: Position
p1 = forall i. Alignable i => i -> i
Alignable.nextAlign Position
p0
        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
                [] ->
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
                AltNum
ralt:[AltNum]
ralts -> do
                    StateNum
sn <- forall start altDoc a.
Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
getStateForAltItems Position
p0 do AltNum
ralt forall a. a -> [a] -> NonEmpty a
:| [AltNum]
ralts
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure do 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
backOpforall a. a -> [a] -> [a]
:[TransOp]
ops
            case AltItemsForTrans -> AltItemsOpForTrans
altItemsForTransOp AltItemsForTrans
altItems of
                AltItemsOpForTrans
AltItemsOpShift -> do
                    let alts :: NonEmpty AltNum
alts = forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse do AltItemsForTrans -> NonEmpty AltNum
altItemsForTransRevAlts AltItemsForTrans
altItems
                    StateNum
sn <- forall start altDoc a.
Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
getStateForAltItems Position
p1 NonEmpty AltNum
alts
                    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 = forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse do AltItemsForTrans -> NonEmpty AltNum
altItemsForTransRevAlts AltItemsForTrans
altItems
                    StateNum
sn <- forall start altDoc a.
Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
getStateForAltItems Position
p1 NonEmpty AltNum
alts
                    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 forall a. a -> Maybe a
Just StateNum
sn]
                            do StateNum
enterSn
                AltItemsOpForTrans
AltItemsOpNot -> do
                    let alts :: NonEmpty AltNum
alts = forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse do AltItemsForTrans -> NonEmpty AltNum
altItemsForTransRevAlts AltItemsForTrans
altItems
                    StateNum
sn <- forall start altDoc a.
Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
getStateForAltItems Position
p1 NonEmpty AltNum
alts
                    let notAlt :: AltNum
notAlt = forall a. NonEmpty a -> a
NonEmpty.head NonEmpty AltNum
alts
                    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 = forall a. NonEmpty a -> a
NonEmpty.last do AltItemsForTrans -> NonEmpty AltNum
altItemsForTransRevAlts AltItemsForTrans
altItems
                    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 :: forall start altDoc a.
Position
-> NonEmpty AltNum -> Pipeline start altDoc a (T AltItemsForTrans)
genAltMapForTrans Position
p (AltNum
alt0 :| [AltNum]
alts0) = T AltItemsForTrans
-> [AltNum]
-> StateT (Context start altDoc a) Identity (T AltItemsForTrans)
go forall a. IntMap a
SymbolicIntMap.empty do AltNum
alt0forall a. a -> [a] -> [a]
:[AltNum]
alts0 where
    go :: T AltItemsForTrans
-> [AltNum]
-> StateT (Context start altDoc a) Identity (T AltItemsForTrans)
go T AltItemsForTrans
m0 = \case
        [] ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure T AltItemsForTrans
m0
        AltNum
alt:[AltNum]
rest -> do
            T AltItemsForTrans
m1 <- T AltItemsForTrans
-> AltNum
-> [AltNum]
-> StateT (Context start altDoc a) Identity (T AltItemsForTrans)
goAlt T AltItemsForTrans
m0 AltNum
alt [AltNum]
rest
            T AltItemsForTrans
-> [AltNum]
-> StateT (Context start altDoc a) Identity (T AltItemsForTrans)
go T AltItemsForTrans
m1 [AltNum]
rest

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

    hasRest :: AltItemsForTrans -> Bool
hasRest AltItemsForTrans
altItems = Bool -> Bool
not do 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
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
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
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
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 :: forall start altDoc a.
Position -> NonEmpty AltNum -> Pipeline start altDoc a StateNum
getStateForAltItems Position
p NonEmpty AltNum
alts = do
    HashMap (Position, NonEmpty AltNum) StateNum
m <- forall start altDoc a r.
(Context start altDoc a -> r) -> Pipeline start altDoc a r
getCtx forall start altDoc a.
Context start altDoc a
-> HashMap (Position, NonEmpty AltNum) StateNum
ctxStateMap
    case 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 ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure StateNum
sn
        Maybe StateNum
Nothing -> do
            StateNum
sn <- forall start a r altDoc.
T start a Identity r -> Pipeline start altDoc a r
liftBuilder forall {k} (m :: * -> *) start (a :: k).
Monad m =>
BuilderT start a m StateNum
SRBBuilder.genNewStateNum
            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 = 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 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)forall a. a -> [a] -> [a]
:forall start altDoc a.
Context start altDoc a -> [(StateNum, Position, NonEmpty AltNum)]
ctxStateQueue Context start altDoc a
ctx
                }
            forall (f :: * -> *) a. Applicative f => a -> f a
pure StateNum
sn

isNeedBackAlts :: NonEmpty LAPEG.AltNum -> Pipeline start altDoc a Bool
isNeedBackAlts :: forall start altDoc a.
NonEmpty AltNum -> Pipeline start altDoc a Bool
isNeedBackAlts = \(AltNum
altn :| [AltNum]
rest) -> 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 <- forall start altDoc a.
AltNum -> Pipeline start altDoc a (Alt altDoc a)
getAlt AltNum
altn0
        case forall altDoc a. Alt altDoc a -> AltKind
LAPEG.altKind Alt altDoc a
alt0 of
            AltKind
PEG.AltNot ->
                forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            AltKind
PEG.AltAnd ->
                forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            AltKind
PEG.AltSeq -> case [AltNum]
rest of
                [] ->
                    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 :: forall start altDoc a.
Position -> AltNum -> Pipeline start altDoc a (Maybe (T, Unit))
getUnitForAltItem Position
p AltNum
altn = do
    Alt altDoc a
alt <- forall start altDoc a.
AltNum -> Pipeline start altDoc a (Alt altDoc a)
getAlt AltNum
altn
    let us :: T Position (HeadRange, Unit)
us = forall altDoc a. Alt altDoc a -> T Position (HeadRange, Unit)
LAPEG.altUnitSeqWithLookAHead Alt altDoc a
alt
    case 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 ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
            forall (f :: * -> *) a. Applicative f => a -> f a
pure do forall a. a -> Maybe a
Just (T
is, Unit
u)

getAlt :: LAPEG.AltNum -> Pipeline start altDoc a (LAPEG.Alt altDoc a)
getAlt :: forall start altDoc a.
AltNum -> Pipeline start altDoc a (Alt altDoc a)
getAlt AltNum
altn = do
    T AltNum (Alt altDoc a)
alts <- forall start altDoc a r.
(Context start altDoc a -> r) -> Pipeline start altDoc a r
getCtx forall start altDoc a.
Context start altDoc a -> T AltNum (Alt altDoc a)
ctxOriginalAlts
    let alt :: Alt altDoc a
alt = forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex T AltNum (Alt altDoc a)
alts AltNum
altn
    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 :: forall start altDoc a r.
(Context start altDoc a -> r) -> Pipeline start altDoc a r
getCtx Context start altDoc a -> r
f = Context start altDoc a -> r
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s. Monad m => StateT s m s
get

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