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