{-# LANGUAGE CPP #-} module Language.Parser.Ptera.Runner.RunT ( T, RunT (..), runT, ParseResult (..), Context (..), initialContext, Position (..), ) where import Language.Parser.Ptera.Prelude import qualified Data.IntMap.Strict as IntMap import qualified Language.Parser.Ptera.Data.Alignable as Alignable import qualified Language.Parser.Ptera.Data.Alignable.Map as AlignableMap import qualified Language.Parser.Ptera.Machine.PEG as PEG import qualified Language.Parser.Ptera.Runner.Parser as Parser import qualified Language.Parser.Ptera.Scanner as Scanner import qualified Language.Parser.Ptera.Syntax as Syntax import qualified Unsafe.Coerce as Unsafe #define DEBUG 0 type T = RunT newtype RunT ctx posMark elem altHelp m a = RunT { forall ctx posMark elem altHelp (m :: * -> *) a. RunT ctx posMark elem altHelp m a -> StateT (Context ctx posMark elem altHelp) m a unRunT :: StateT (Context ctx posMark elem altHelp) m a } deriving forall a b. a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m a forall a b. (a -> b) -> RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b forall ctx posMark elem altHelp (m :: * -> *) a b. Functor m => a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m a forall ctx posMark elem altHelp (m :: * -> *) a b. Functor m => (a -> b) -> RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: forall a b. a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m a $c<$ :: forall ctx posMark elem altHelp (m :: * -> *) a b. Functor m => a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m a fmap :: forall a b. (a -> b) -> RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b $cfmap :: forall ctx posMark elem altHelp (m :: * -> *) a b. Functor m => (a -> b) -> RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b Functor deriving ( forall a. a -> RunT ctx posMark elem altHelp m a forall a b. RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m a forall a b. RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m b forall a b. RunT ctx posMark elem altHelp m (a -> b) -> RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b forall a b c. (a -> b -> c) -> RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m c forall {ctx} {posMark} {elem} {altHelp} {m :: * -> *}. Monad m => Functor (RunT ctx posMark elem altHelp m) forall ctx posMark elem altHelp (m :: * -> *) a. Monad m => a -> RunT ctx posMark elem altHelp m a forall ctx posMark elem altHelp (m :: * -> *) a b. Monad m => RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m a forall ctx posMark elem altHelp (m :: * -> *) a b. Monad m => RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m b forall ctx posMark elem altHelp (m :: * -> *) a b. Monad m => RunT ctx posMark elem altHelp m (a -> b) -> RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b forall ctx posMark elem altHelp (m :: * -> *) a b c. Monad m => (a -> b -> c) -> RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m c forall (f :: * -> *). Functor f -> (forall a. a -> f a) -> (forall a b. f (a -> b) -> f a -> f b) -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c) -> (forall a b. f a -> f b -> f b) -> (forall a b. f a -> f b -> f a) -> Applicative f <* :: forall a b. RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m a $c<* :: forall ctx posMark elem altHelp (m :: * -> *) a b. Monad m => RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m a *> :: forall a b. RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m b $c*> :: forall ctx posMark elem altHelp (m :: * -> *) a b. Monad m => RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m b liftA2 :: forall a b c. (a -> b -> c) -> RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m c $cliftA2 :: forall ctx posMark elem altHelp (m :: * -> *) a b c. Monad m => (a -> b -> c) -> RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m c <*> :: forall a b. RunT ctx posMark elem altHelp m (a -> b) -> RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b $c<*> :: forall ctx posMark elem altHelp (m :: * -> *) a b. Monad m => RunT ctx posMark elem altHelp m (a -> b) -> RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b pure :: forall a. a -> RunT ctx posMark elem altHelp m a $cpure :: forall ctx posMark elem altHelp (m :: * -> *) a. Monad m => a -> RunT ctx posMark elem altHelp m a Applicative, forall a. a -> RunT ctx posMark elem altHelp m a forall a b. RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m b forall a b. RunT ctx posMark elem altHelp m a -> (a -> RunT ctx posMark elem altHelp m b) -> RunT ctx posMark elem altHelp m b forall ctx posMark elem altHelp (m :: * -> *). Monad m => Applicative (RunT ctx posMark elem altHelp m) forall ctx posMark elem altHelp (m :: * -> *) a. Monad m => a -> RunT ctx posMark elem altHelp m a forall ctx posMark elem altHelp (m :: * -> *) a b. Monad m => RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m b forall ctx posMark elem altHelp (m :: * -> *) a b. Monad m => RunT ctx posMark elem altHelp m a -> (a -> RunT ctx posMark elem altHelp m b) -> RunT ctx posMark elem altHelp m b forall (m :: * -> *). Applicative m -> (forall a b. m a -> (a -> m b) -> m b) -> (forall a b. m a -> m b -> m b) -> (forall a. a -> m a) -> Monad m return :: forall a. a -> RunT ctx posMark elem altHelp m a $creturn :: forall ctx posMark elem altHelp (m :: * -> *) a. Monad m => a -> RunT ctx posMark elem altHelp m a >> :: forall a b. RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m b $c>> :: forall ctx posMark elem altHelp (m :: * -> *) a b. Monad m => RunT ctx posMark elem altHelp m a -> RunT ctx posMark elem altHelp m b -> RunT ctx posMark elem altHelp m b >>= :: forall a b. RunT ctx posMark elem altHelp m a -> (a -> RunT ctx posMark elem altHelp m b) -> RunT ctx posMark elem altHelp m b $c>>= :: forall ctx posMark elem altHelp (m :: * -> *) a b. Monad m => RunT ctx posMark elem altHelp m a -> (a -> RunT ctx posMark elem altHelp m b) -> RunT ctx posMark elem altHelp m b Monad ) via (StateT (Context ctx posMark elem altHelp) m) instance MonadTrans (RunT ctx posMark elem altHelp) where lift :: forall (m :: * -> *) a. Monad m => m a -> RunT ctx posMark elem altHelp m a lift m a mx = forall ctx posMark elem altHelp (m :: * -> *) a. StateT (Context ctx posMark elem altHelp) m a -> RunT ctx posMark elem altHelp m a RunT do forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift m a mx runT :: forall ctx posMark elem altHelp m a. Scanner.T posMark elem m => RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a) runT :: forall ctx posMark elem altHelp (m :: * -> *) a. T posMark elem m => RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a) runT = RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a) go where go :: RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a) go = do (TokenNum tok, Maybe elem _) <- forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => RunT ctx posMark elem altHelp m (TokenNum, Maybe elem) consumeIfNeeded TokenNum sn <- forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> TokenNum ctxState if TokenNum sn forall a. Ord a => a -> a -> Bool < TokenNum 0 then TokenNum -> RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a) goResult TokenNum tok else forall ctx posMark elem altHelp (m :: * -> *). T posMark elem m => TokenNum -> RunT ctx posMark elem altHelp m RunningResult transByInput TokenNum tok forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case RunningResult ContParse -> RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a) go RunningResult CantContParse -> RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a) goFailed goResult :: Parser.TokenNum -> RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a) goResult :: TokenNum -> RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a) goResult TokenNum tok = forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> [Item posMark ctx] ctxItemStack forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case [ItemArgument (Parser.ReduceArgument a x)] -> forall (f :: * -> *) a. Applicative f => a -> f a pure do forall posMark altHelp a. a -> ParseResult posMark altHelp a Parsed do forall a b. a -> b Unsafe.unsafeCoerce a x [Item posMark ctx] _ -> do if TokenNum tok forall a. Ord a => a -> a -> Bool >= TokenNum 0 then forall posMark elem (m :: * -> *) altHelp ctx. T posMark elem m => FailedReason altHelp -> RunT ctx posMark elem altHelp m () reportError forall altHelp. FailedReason altHelp FailedByEarlyParsed else forall posMark elem (m :: * -> *) altHelp ctx. T posMark elem m => FailedReason altHelp -> RunT ctx posMark elem altHelp m () reportError forall altHelp. FailedReason altHelp FailedByNotEnoughInput RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a) goFailed goFailed :: RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a) goFailed :: RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a) goFailed = forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> Maybe (Position, posMark, FailedReason altHelp) ctxDeepestError forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Just (Position _, posMark posMark0, FailedReason altHelp failedReason) -> forall (f :: * -> *) a. Applicative f => a -> f a pure do forall posMark altHelp a. posMark -> FailedReason altHelp -> ParseResult posMark altHelp a ParseFailed posMark posMark0 FailedReason altHelp failedReason Maybe (Position, posMark, FailedReason altHelp) Nothing -> forall a. HasCallStack => [Char] -> a error [Char] "unreachable: any errors are available." data ParseResult posMark altHelp a = Parsed a | ParseFailed posMark (FailedReason altHelp) deriving (TokenNum -> ParseResult posMark altHelp a -> ShowS forall a. (TokenNum -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a forall posMark altHelp a. (Show a, Show posMark, Show altHelp) => TokenNum -> ParseResult posMark altHelp a -> ShowS forall posMark altHelp a. (Show a, Show posMark, Show altHelp) => [ParseResult posMark altHelp a] -> ShowS forall posMark altHelp a. (Show a, Show posMark, Show altHelp) => ParseResult posMark altHelp a -> [Char] showList :: [ParseResult posMark altHelp a] -> ShowS $cshowList :: forall posMark altHelp a. (Show a, Show posMark, Show altHelp) => [ParseResult posMark altHelp a] -> ShowS show :: ParseResult posMark altHelp a -> [Char] $cshow :: forall posMark altHelp a. (Show a, Show posMark, Show altHelp) => ParseResult posMark altHelp a -> [Char] showsPrec :: TokenNum -> ParseResult posMark altHelp a -> ShowS $cshowsPrec :: forall posMark altHelp a. (Show a, Show posMark, Show altHelp) => TokenNum -> ParseResult posMark altHelp a -> ShowS Show, forall a b. a -> ParseResult posMark altHelp b -> ParseResult posMark altHelp a forall a b. (a -> b) -> ParseResult posMark altHelp a -> ParseResult posMark altHelp b forall posMark altHelp a b. a -> ParseResult posMark altHelp b -> ParseResult posMark altHelp a forall posMark altHelp a b. (a -> b) -> ParseResult posMark altHelp a -> ParseResult posMark altHelp b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: forall a b. a -> ParseResult posMark altHelp b -> ParseResult posMark altHelp a $c<$ :: forall posMark altHelp a b. a -> ParseResult posMark altHelp b -> ParseResult posMark altHelp a fmap :: forall a b. (a -> b) -> ParseResult posMark altHelp a -> ParseResult posMark altHelp b $cfmap :: forall posMark altHelp a b. (a -> b) -> ParseResult posMark altHelp a -> ParseResult posMark altHelp b Functor) data FailedReason altHelp = FailedWithHelp [(StringLit, Maybe altHelp, Maybe Int)] | FailedToStart | FailedByEarlyParsed | FailedByNotEnoughInput deriving (TokenNum -> FailedReason altHelp -> ShowS forall altHelp. Show altHelp => TokenNum -> FailedReason altHelp -> ShowS forall altHelp. Show altHelp => [FailedReason altHelp] -> ShowS forall altHelp. Show altHelp => FailedReason altHelp -> [Char] forall a. (TokenNum -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a showList :: [FailedReason altHelp] -> ShowS $cshowList :: forall altHelp. Show altHelp => [FailedReason altHelp] -> ShowS show :: FailedReason altHelp -> [Char] $cshow :: forall altHelp. Show altHelp => FailedReason altHelp -> [Char] showsPrec :: TokenNum -> FailedReason altHelp -> ShowS $cshowsPrec :: forall altHelp. Show altHelp => TokenNum -> FailedReason altHelp -> ShowS Show, forall a b. a -> FailedReason b -> FailedReason a forall a b. (a -> b) -> FailedReason a -> FailedReason b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: forall a b. a -> FailedReason b -> FailedReason a $c<$ :: forall a b. a -> FailedReason b -> FailedReason a fmap :: forall a b. (a -> b) -> FailedReason a -> FailedReason b $cfmap :: forall a b. (a -> b) -> FailedReason a -> FailedReason b Functor) data Context ctx posMark elem altHelp = Context { forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> T ctx elem altHelp ctxParser :: Parser.T ctx elem altHelp , forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> TokenNum ctxState :: Parser.StateNum , forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> [Item posMark ctx] ctxItemStack :: [Item posMark ctx] , forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> Maybe (Position, posMark, TokenNum, Maybe elem) ctxLookAHeadToken :: Maybe (Position, posMark, Parser.TokenNum, Maybe elem) , forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> Position ctxNextPosition :: Position , forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> Maybe (Position, posMark, FailedReason altHelp) ctxDeepestError :: Maybe (Position, posMark, FailedReason altHelp) , forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> T Position (IntMap (MemoItem posMark)) ctxMemoTable :: AlignableMap.T Position (IntMap.IntMap (MemoItem posMark)) , forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> TokenNum ctxNeedBackItemsCount :: Int , forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> ctx ctxCustomContext :: ctx } newtype Position = Position Int deriving (Position -> Position -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Position -> Position -> Bool $c/= :: Position -> Position -> Bool == :: Position -> Position -> Bool $c== :: Position -> Position -> Bool Eq, Eq Position Position -> Position -> Bool Position -> Position -> Ordering Position -> Position -> Position forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: Position -> Position -> Position $cmin :: Position -> Position -> Position max :: Position -> Position -> Position $cmax :: Position -> Position -> Position >= :: Position -> Position -> Bool $c>= :: Position -> Position -> Bool > :: Position -> Position -> Bool $c> :: Position -> Position -> Bool <= :: Position -> Position -> Bool $c<= :: Position -> Position -> Bool < :: Position -> Position -> Bool $c< :: Position -> Position -> Bool compare :: Position -> Position -> Ordering $ccompare :: Position -> Position -> Ordering Ord, TokenNum -> Position -> ShowS [Position] -> ShowS Position -> [Char] forall a. (TokenNum -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a showList :: [Position] -> ShowS $cshowList :: [Position] -> ShowS show :: Position -> [Char] $cshow :: Position -> [Char] showsPrec :: TokenNum -> Position -> ShowS $cshowsPrec :: TokenNum -> Position -> ShowS Show) deriving Coercible TokenNum Position forall i. Coercible TokenNum i -> Alignable i Alignable.T via Alignable.Inst data MemoItem posMark = MemoItemParsed Position posMark Parser.ReduceArgument | MemoItemFailed data Item posMark ctx = ItemEnter Position (Maybe posMark) Parser.VarNum Parser.StateNum | ItemHandleNot Parser.AltNum | ItemBackpoint Position posMark Parser.StateNum | ItemArgument Parser.ReduceArgument | ItemModifyCustomContext ctx data RunningResult = ContParse | CantContParse deriving (RunningResult -> RunningResult -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: RunningResult -> RunningResult -> Bool $c/= :: RunningResult -> RunningResult -> Bool == :: RunningResult -> RunningResult -> Bool $c== :: RunningResult -> RunningResult -> Bool Eq, TokenNum -> RunningResult -> ShowS [RunningResult] -> ShowS RunningResult -> [Char] forall a. (TokenNum -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a showList :: [RunningResult] -> ShowS $cshowList :: [RunningResult] -> ShowS show :: RunningResult -> [Char] $cshow :: RunningResult -> [Char] showsPrec :: TokenNum -> RunningResult -> ShowS $cshowsPrec :: TokenNum -> RunningResult -> ShowS Show) initialContext :: Parser.T ctx elem altHelp -> ctx -> Parser.StartNum -> Maybe (Context ctx posMark elem altHelp) initialContext :: forall ctx elem altHelp posMark. T ctx elem altHelp -> ctx -> TokenNum -> Maybe (Context ctx posMark elem altHelp) initialContext T ctx elem altHelp parser ctx ctx0 TokenNum s0 = do TokenNum sn0 <- forall ctx elem altHelp. RunnerParser ctx elem altHelp -> TokenNum -> Maybe TokenNum Parser.parserInitial T ctx elem altHelp parser TokenNum s0 forall (f :: * -> *) a. Applicative f => a -> f a pure do Context { $sel:ctxParser:Context :: T ctx elem altHelp ctxParser = T ctx elem altHelp parser , $sel:ctxState:Context :: TokenNum ctxState = TokenNum sn0 , $sel:ctxLookAHeadToken:Context :: Maybe (Position, posMark, TokenNum, Maybe elem) ctxLookAHeadToken = forall a. Maybe a Nothing , $sel:ctxItemStack:Context :: [Item posMark ctx] ctxItemStack = [] , $sel:ctxNextPosition:Context :: Position ctxNextPosition = forall i. Alignable i => i Alignable.initialAlign , $sel:ctxMemoTable:Context :: T Position (IntMap (MemoItem posMark)) ctxMemoTable = forall {k} (n :: k) a. Map n a AlignableMap.empty , $sel:ctxNeedBackItemsCount:Context :: TokenNum ctxNeedBackItemsCount = TokenNum 0 , $sel:ctxCustomContext:Context :: ctx ctxCustomContext = ctx ctx0 , $sel:ctxDeepestError:Context :: Maybe (Position, posMark, FailedReason altHelp) ctxDeepestError = forall a. Maybe a Nothing } transByInput :: forall ctx posMark elem altHelp m . Scanner.T posMark elem m => Parser.TokenNum -> RunT ctx posMark elem altHelp m RunningResult transByInput :: forall ctx posMark elem altHelp (m :: * -> *). T posMark elem m => TokenNum -> RunT ctx posMark elem altHelp m RunningResult transByInput TokenNum tok = RunT ctx posMark elem altHelp m RunningResult go where go :: RunT ctx posMark elem altHelp m RunningResult go = do T ctx elem altHelp parser <- forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> T ctx elem altHelp ctxParser TokenNum sn0 <- forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> TokenNum ctxState let trans1 :: Trans trans1 = forall ctx elem altHelp. RunnerParser ctx elem altHelp -> TokenNum -> TokenNum -> Trans Parser.parserTrans T ctx elem altHelp parser TokenNum sn0 TokenNum tok let sn1 :: TokenNum sn1 = Trans -> TokenNum Parser.transState Trans trans1 forall (m :: * -> *) ctx posMark elem altHelp. Monad m => TokenNum -> RunT ctx posMark elem altHelp m () setNextState TokenNum sn1 #if DEBUG (pos0, _) <- getCurrentPosition itemStackShow <- prettyShowItemStack debugTraceShow ("transByInput", sn0, pos0, tok, trans1, itemStackShow) do pure () #endif case Trans -> [TransOp] Parser.transOps Trans trans1 of ops :: [TransOp] ops@(TransOp _:[TransOp] _) -> [TransOp] -> RunT ctx posMark elem altHelp m RunningResult goTransOps [TransOp] ops [] | TokenNum sn1 forall a. Ord a => a -> a -> Bool < TokenNum 0 -> forall ctx posMark elem altHelp (m :: * -> *). T posMark elem m => TokenNum -> RunT ctx posMark elem altHelp m RunningResult parseFailWithState TokenNum sn0 | Bool otherwise -> forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult ContParse goTransOps :: [Parser.TransOp] -> RunT ctx posMark elem altHelp m RunningResult goTransOps :: [TransOp] -> RunT ctx posMark elem altHelp m RunningResult goTransOps = \case [] -> forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult ContParse TransOp op:[TransOp] ops -> do RunningResult result <- forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => TransOp -> RunT ctx posMark elem altHelp m RunningResult runTransOp TransOp op case RunningResult result of RunningResult ContParse -> [TransOp] -> RunT ctx posMark elem altHelp m RunningResult goTransOps [TransOp] ops RunningResult CantContParse -> forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult CantContParse #if DEBUG prettyShowItemStack :: Monad m => RunT ctx posMark elem altHelp m [StringLit] prettyShowItemStack = do itemStack <- getCtx ctxItemStack pure [ showItem item | item <- itemStack ] where showItem = \case ItemEnter p _ v s -> "ItemEnter " <> show (p, v, s) ItemHandleNot alt -> "ItemHandleNot " <> show alt ItemBackpoint p _ s -> "ItemBackpoint " <> show (p, s) ItemArgument _ -> "ItemArgument" ItemModifyCustomContext _ -> "ItemModifyCustomContext" #endif runTransOp :: Scanner.T posMark elem m => Parser.TransOp -> RunT ctx posMark elem altHelp m RunningResult runTransOp :: forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => TransOp -> RunT ctx posMark elem altHelp m RunningResult runTransOp = \case Parser.TransOpEnter TokenNum v Bool needBack TokenNum enterSn -> forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => TokenNum -> Bool -> TokenNum -> RunT ctx posMark elem altHelp m RunningResult runEnter TokenNum v Bool needBack TokenNum enterSn Parser.TransOpPushBackpoint TokenNum backSn -> do (Position pos, posMark mark) <- forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => RunT ctx posMark elem altHelp m (Position, posMark) getCurrentPosition forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => Item posMark ctx -> RunT ctx posMark elem altHelp m () pushItem do forall posMark ctx. Position -> posMark -> TokenNum -> Item posMark ctx ItemBackpoint Position pos posMark mark TokenNum backSn forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult ContParse Parser.TransOpHandleNot TokenNum alt -> do forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => Item posMark ctx -> RunT ctx posMark elem altHelp m () pushItem do forall posMark ctx. TokenNum -> Item posMark ctx ItemHandleNot TokenNum alt forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult ContParse TransOp Parser.TransOpShift -> forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => RunT ctx posMark elem altHelp m (TokenNum, Maybe elem) consumeIfNeeded forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case (TokenNum _, Maybe elem Nothing) -> forall ctx posMark elem altHelp (m :: * -> *). T posMark elem m => Maybe (FailedReason altHelp) -> RunT ctx posMark elem altHelp m RunningResult parseFail do forall a. a -> Maybe a Just forall altHelp. FailedReason altHelp FailedByNotEnoughInput (TokenNum _, Just elem x) -> do forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => Item posMark ctx -> RunT ctx posMark elem altHelp m () pushItem do forall posMark ctx. ReduceArgument -> Item posMark ctx ItemArgument do forall a. a -> ReduceArgument Parser.ReduceArgument elem x forall (m :: * -> *) ctx posMark elem altHelp. Monad m => RunT ctx posMark elem altHelp m () shift forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult ContParse Parser.TransOpReduce TokenNum alt -> forall ctx posMark elem altHelp (m :: * -> *). T posMark elem m => TokenNum -> RunT ctx posMark elem altHelp m RunningResult runReduce TokenNum alt runEnter :: Scanner.T posMark elem m => Parser.VarNum -> Bool -> Parser.StateNum -> RunT ctx posMark elem altHelp m RunningResult runEnter :: forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => TokenNum -> Bool -> TokenNum -> RunT ctx posMark elem altHelp m RunningResult runEnter TokenNum v Bool needBack TokenNum enterSn = do (Position pos0, posMark mark0) <- forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => RunT ctx posMark elem altHelp m (Position, posMark) getCurrentPosition T Position (IntMap (MemoItem posMark)) memoTable <- forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> T Position (IntMap (MemoItem posMark)) ctxMemoTable let vm :: IntMap (MemoItem posMark) vm = case forall n a. T n => n -> Map n a -> Maybe a AlignableMap.lookup Position pos0 T Position (IntMap (MemoItem posMark)) memoTable of Maybe (IntMap (MemoItem posMark)) Nothing -> forall a. IntMap a IntMap.empty Just IntMap (MemoItem posMark) m -> IntMap (MemoItem posMark) m case forall a. TokenNum -> IntMap a -> Maybe a IntMap.lookup TokenNum v IntMap (MemoItem posMark) vm of Maybe (MemoItem posMark) Nothing -> do let mmark0 :: Maybe posMark mmark0 = if Bool needBack then forall a. a -> Maybe a Just posMark mark0 else forall a. Maybe a Nothing forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => Item posMark ctx -> RunT ctx posMark elem altHelp m () pushItem do forall posMark ctx. Position -> Maybe posMark -> TokenNum -> TokenNum -> Item posMark ctx ItemEnter Position pos0 Maybe posMark mmark0 TokenNum v TokenNum enterSn forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult ContParse Just MemoItem posMark memoItem -> case MemoItem posMark memoItem of MemoItemParsed Position pos1 posMark mark1 ReduceArgument x -> do #if DEBUG debugTraceShow ("runEnter / MemoItemParsed", v, enterSn, pos1) do pure () #endif forall (m :: * -> *) ctx posMark elem altHelp. Monad m => TokenNum -> RunT ctx posMark elem altHelp m () setNextState TokenNum enterSn forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => Item posMark ctx -> RunT ctx posMark elem altHelp m () pushItem do forall posMark ctx. ReduceArgument -> Item posMark ctx ItemArgument ReduceArgument x forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => Position -> posMark -> RunT ctx posMark elem altHelp m () seekToMark Position pos1 posMark mark1 forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult ContParse MemoItem posMark MemoItemFailed -> do #if DEBUG debugTraceShow ("runEnter / MemoItemFailed", v, enterSn) do pure () #endif forall ctx posMark elem altHelp (m :: * -> *). T posMark elem m => Maybe (FailedReason altHelp) -> RunT ctx posMark elem altHelp m RunningResult parseFail forall a. Maybe a Nothing #if DEBUG debugShowHelpAlt :: Monad m => StringLit -> Parser.AltNum -> RunT ctx posMark elem altHelp m () debugShowHelpAlt msg alt = do parser <- getCtx ctxParser let (dv, _) = Parser.parserAltHelp parser alt debugTraceShow (msg, alt, dv) do pure () #endif runReduce :: forall ctx posMark elem altHelp m . Scanner.T posMark elem m => Parser.AltNum -> RunT ctx posMark elem altHelp m RunningResult runReduce :: forall ctx posMark elem altHelp (m :: * -> *). T posMark elem m => TokenNum -> RunT ctx posMark elem altHelp m RunningResult runReduce TokenNum alt = RunT ctx posMark elem altHelp m RunningResult go0 where go0 :: RunT ctx posMark elem altHelp m RunningResult go0 = do #if DEBUG debugShowHelpAlt "runReduce" alt #endif Context ctx posMark elem altHelp capturedCtxForFail <- forall (m :: * -> *) ctx posMark elem altHelp. Monad m => RunT ctx posMark elem altHelp m (Context ctx posMark elem altHelp) captureCtx Context ctx posMark elem altHelp -> Maybe ctx -> [ReduceArgument] -> RunT ctx posMark elem altHelp m RunningResult go Context ctx posMark elem altHelp capturedCtxForFail forall a. Maybe a Nothing [] go :: Context ctx posMark elem altHelp -> Maybe ctx -> [ReduceArgument] -> RunT ctx posMark elem altHelp m RunningResult go Context ctx posMark elem altHelp capturedCtxForFail Maybe ctx mrollbackCustomCtx0 [ReduceArgument] args = forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx)) popItem forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Maybe (Item posMark ctx) Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult CantContParse Just Item posMark ctx item -> case Item posMark ctx item of ItemArgument ReduceArgument x -> do Context ctx posMark elem altHelp -> Maybe ctx -> [ReduceArgument] -> RunT ctx posMark elem altHelp m RunningResult go Context ctx posMark elem altHelp capturedCtxForFail Maybe ctx mrollbackCustomCtx0 do ReduceArgument xforall a. a -> [a] -> [a] :[ReduceArgument] args ItemModifyCustomContext ctx customCtx -> Context ctx posMark elem altHelp -> Maybe ctx -> [ReduceArgument] -> RunT ctx posMark elem altHelp m RunningResult go Context ctx posMark elem altHelp capturedCtxForFail do forall a. a -> Maybe a Just ctx customCtx do [ReduceArgument] args ItemBackpoint{} -> do Context ctx posMark elem altHelp -> Maybe ctx -> [ReduceArgument] -> RunT ctx posMark elem altHelp m RunningResult go Context ctx posMark elem altHelp capturedCtxForFail Maybe ctx mrollbackCustomCtx0 [ReduceArgument] args ItemHandleNot{} -> do forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ Maybe ctx mrollbackCustomCtx0 \ctx customCtx -> forall (m :: * -> *) ctx posMark elem altHelp. Monad m => ctx -> RunT ctx posMark elem altHelp m () updateCustomContext ctx customCtx forall ctx posMark elem altHelp (m :: * -> *). T posMark elem m => TokenNum -> RunT ctx posMark elem altHelp m RunningResult parseFailWithAlt TokenNum alt ItemEnter Position pos Maybe posMark mmark TokenNum v TokenNum enterSn -> Context ctx posMark elem altHelp -> Maybe ctx -> [ReduceArgument] -> Position -> Maybe posMark -> TokenNum -> TokenNum -> RunT ctx posMark elem altHelp m RunningResult goEnter Context ctx posMark elem altHelp capturedCtxForFail Maybe ctx mrollbackCustomCtx0 [ReduceArgument] args Position pos Maybe posMark mmark TokenNum v TokenNum enterSn goEnter :: Context ctx posMark elem altHelp -> Maybe ctx -> [ReduceArgument] -> Position -> Maybe posMark -> TokenNum -> TokenNum -> RunT ctx posMark elem altHelp m RunningResult goEnter Context ctx posMark elem altHelp capturedCtxForFail Maybe ctx mrollbackCustomCtx [ReduceArgument] args Position pos0 Maybe posMark mmark0 TokenNum v TokenNum enterSn = do T ctx elem altHelp parser <- forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> T ctx elem altHelp ctxParser case forall ctx elem altHelp. RunnerParser ctx elem altHelp -> TokenNum -> AltKind Parser.parserAltKind T ctx elem altHelp parser TokenNum alt of AltKind PEG.AltSeq -> forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => TokenNum -> Position -> Maybe ctx -> TokenNum -> [ReduceArgument] -> RunT ctx posMark elem altHelp m Bool runActionAndSaveEnterResult TokenNum v Position pos0 Maybe ctx mrollbackCustomCtx TokenNum alt [ReduceArgument] args forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Bool False -> do forall (m :: * -> *) ctx posMark elem altHelp. Monad m => Context ctx posMark elem altHelp -> RunT ctx posMark elem altHelp m () restoreCtx Context ctx posMark elem altHelp capturedCtxForFail forall ctx posMark elem altHelp (m :: * -> *). T posMark elem m => TokenNum -> RunT ctx posMark elem altHelp m RunningResult parseFailWithAlt TokenNum alt Bool True -> do forall (m :: * -> *) ctx posMark elem altHelp. Monad m => TokenNum -> RunT ctx posMark elem altHelp m () setNextState TokenNum enterSn forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult ContParse AltKind PEG.AltAnd -> forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => TokenNum -> Position -> Maybe ctx -> TokenNum -> [ReduceArgument] -> RunT ctx posMark elem altHelp m Bool runActionAndSaveEnterResult TokenNum v Position pos0 Maybe ctx mrollbackCustomCtx TokenNum alt [ReduceArgument] args forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Bool False -> do forall (m :: * -> *) ctx posMark elem altHelp. Monad m => Context ctx posMark elem altHelp -> RunT ctx posMark elem altHelp m () restoreCtx Context ctx posMark elem altHelp capturedCtxForFail forall ctx posMark elem altHelp (m :: * -> *). T posMark elem m => TokenNum -> RunT ctx posMark elem altHelp m RunningResult parseFailWithAlt TokenNum alt Bool True -> do let mark0 :: posMark mark0 = case Maybe posMark mmark0 of Maybe posMark Nothing -> forall a. HasCallStack => [Char] -> a error [Char] "unreachable: no mark with and alternative" Just posMark x -> posMark x forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => Position -> posMark -> RunT ctx posMark elem altHelp m () seekToMark Position pos0 posMark mark0 forall (m :: * -> *) ctx posMark elem altHelp. Monad m => TokenNum -> RunT ctx posMark elem altHelp m () setNextState TokenNum enterSn forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult ContParse AltKind PEG.AltNot -> forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult CantContParse parseFailWithAlt :: forall ctx posMark elem altHelp m . Scanner.T posMark elem m => Parser.AltNum -> RunT ctx posMark elem altHelp m RunningResult parseFailWithAlt :: forall ctx posMark elem altHelp (m :: * -> *). T posMark elem m => TokenNum -> RunT ctx posMark elem altHelp m RunningResult parseFailWithAlt TokenNum alt = do T ctx elem altHelp parser <- forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> T ctx elem altHelp ctxParser let ([Char] varHelp, Maybe altHelp altHelp) = forall ctx elem altHelp. RunnerParser ctx elem altHelp -> TokenNum -> ([Char], Maybe altHelp) Parser.parserAltHelp T ctx elem altHelp parser TokenNum alt forall ctx posMark elem altHelp (m :: * -> *). T posMark elem m => Maybe (FailedReason altHelp) -> RunT ctx posMark elem altHelp m RunningResult parseFail do forall a. a -> Maybe a Just do forall altHelp. [([Char], Maybe altHelp, Maybe TokenNum)] -> FailedReason altHelp FailedWithHelp [([Char] varHelp, Maybe altHelp altHelp, forall a. Maybe a Nothing)] parseFailWithState :: forall ctx posMark elem altHelp m . Scanner.T posMark elem m => Parser.StateNum -> RunT ctx posMark elem altHelp m RunningResult parseFailWithState :: forall ctx posMark elem altHelp (m :: * -> *). T posMark elem m => TokenNum -> RunT ctx posMark elem altHelp m RunningResult parseFailWithState TokenNum sn = do T ctx elem altHelp parser <- forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> T ctx elem altHelp ctxParser let altItems :: [(TokenNum, TokenNum)] altItems = forall ctx elem altHelp. RunnerParser ctx elem altHelp -> TokenNum -> [(TokenNum, TokenNum)] Parser.parserStateHelp T ctx elem altHelp parser TokenNum sn let helps :: [([Char], Maybe altHelp, Maybe TokenNum)] helps = [ ( [Char] varHelp , Maybe altHelp altHelp , forall a. a -> Maybe a Just TokenNum pos ) | (TokenNum alt, TokenNum pos) <- [(TokenNum, TokenNum)] altItems , let ([Char] varHelp, Maybe altHelp altHelp) = forall ctx elem altHelp. RunnerParser ctx elem altHelp -> TokenNum -> ([Char], Maybe altHelp) Parser.parserAltHelp T ctx elem altHelp parser TokenNum alt ] forall ctx posMark elem altHelp (m :: * -> *). T posMark elem m => Maybe (FailedReason altHelp) -> RunT ctx posMark elem altHelp m RunningResult parseFail do forall a. a -> Maybe a Just do forall altHelp. [([Char], Maybe altHelp, Maybe TokenNum)] -> FailedReason altHelp FailedWithHelp [([Char], Maybe altHelp, Maybe TokenNum)] helps parseFail :: forall ctx posMark elem altHelp m . Scanner.T posMark elem m => Maybe (FailedReason altHelp) -> RunT ctx posMark elem altHelp m RunningResult parseFail :: forall ctx posMark elem altHelp (m :: * -> *). T posMark elem m => Maybe (FailedReason altHelp) -> RunT ctx posMark elem altHelp m RunningResult parseFail = Maybe (FailedReason altHelp) -> RunT ctx posMark elem altHelp m RunningResult go0 where go0 :: Maybe (FailedReason altHelp) -> RunT ctx posMark elem altHelp m RunningResult go0 :: Maybe (FailedReason altHelp) -> RunT ctx posMark elem altHelp m RunningResult go0 Maybe (FailedReason altHelp) mayFailedReason = do #if DEBUG debugTraceShow ("parseFail", fmap (const ()) <$> mayFailedReason) do pure () #endif case Maybe (FailedReason altHelp) mayFailedReason of Maybe (FailedReason altHelp) Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a pure () Just FailedReason altHelp failedReason -> do forall posMark elem (m :: * -> *) altHelp ctx. T posMark elem m => FailedReason altHelp -> RunT ctx posMark elem altHelp m () reportError FailedReason altHelp failedReason Maybe ctx -> RunT ctx posMark elem altHelp m RunningResult go forall a. Maybe a Nothing go :: Maybe ctx -> RunT ctx posMark elem altHelp m RunningResult go :: Maybe ctx -> RunT ctx posMark elem altHelp m RunningResult go Maybe ctx mrollbackCustomCtx0 = forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx)) popItem forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Maybe (Item posMark ctx) Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult CantContParse Just Item posMark ctx item -> case Item posMark ctx item of ItemBackpoint Position pos posMark p TokenNum backSn -> do forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ Maybe ctx mrollbackCustomCtx0 \ctx customCtx -> forall (m :: * -> *) ctx posMark elem altHelp. Monad m => ctx -> RunT ctx posMark elem altHelp m () updateCustomContext ctx customCtx forall (m :: * -> *) ctx posMark elem altHelp. Monad m => TokenNum -> RunT ctx posMark elem altHelp m () setNextState TokenNum backSn forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => Position -> posMark -> RunT ctx posMark elem altHelp m () seekToMark Position pos posMark p forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult ContParse ItemHandleNot TokenNum alt -> do forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ Maybe ctx mrollbackCustomCtx0 \ctx customCtx -> forall (m :: * -> *) ctx posMark elem altHelp. Monad m => ctx -> RunT ctx posMark elem altHelp m () updateCustomContext ctx customCtx Context ctx posMark elem altHelp capturedCtxForFail <- forall (m :: * -> *) ctx posMark elem altHelp. Monad m => RunT ctx posMark elem altHelp m (Context ctx posMark elem altHelp) captureCtx Context ctx posMark elem altHelp -> Maybe ctx -> TokenNum -> RunT ctx posMark elem altHelp m RunningResult goHandleNot Context ctx posMark elem altHelp capturedCtxForFail forall a. Maybe a Nothing TokenNum alt ItemModifyCustomContext ctx customCtx -> Maybe ctx -> RunT ctx posMark elem altHelp m RunningResult go do forall a. a -> Maybe a Just ctx customCtx ItemArgument{} -> Maybe ctx -> RunT ctx posMark elem altHelp m RunningResult go Maybe ctx mrollbackCustomCtx0 ItemEnter Position pos0 Maybe posMark _ TokenNum v TokenNum _ -> do forall (m :: * -> *) ctx posMark elem altHelp. Monad m => TokenNum -> Position -> RunT ctx posMark elem altHelp m () saveFailedEnterAction TokenNum v Position pos0 Maybe ctx -> RunT ctx posMark elem altHelp m RunningResult go Maybe ctx mrollbackCustomCtx0 goHandleNot :: Context ctx posMark elem altHelp -> Maybe ctx -> TokenNum -> RunT ctx posMark elem altHelp m RunningResult goHandleNot Context ctx posMark elem altHelp capturedCtxForFail Maybe ctx mrollbackCustomCtx0 TokenNum alt = forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx)) popItem forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Maybe (Item posMark ctx) Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult CantContParse Just Item posMark ctx item -> case Item posMark ctx item of ItemEnter Position pos0 Maybe posMark mmark0 TokenNum v TokenNum enterSn -> Context ctx posMark elem altHelp -> Maybe ctx -> TokenNum -> Position -> Maybe posMark -> TokenNum -> TokenNum -> RunT ctx posMark elem altHelp m RunningResult goEnter Context ctx posMark elem altHelp capturedCtxForFail Maybe ctx mrollbackCustomCtx0 TokenNum alt Position pos0 Maybe posMark mmark0 TokenNum v TokenNum enterSn ItemArgument{} -> Context ctx posMark elem altHelp -> Maybe ctx -> TokenNum -> RunT ctx posMark elem altHelp m RunningResult goHandleNot Context ctx posMark elem altHelp capturedCtxForFail Maybe ctx mrollbackCustomCtx0 TokenNum alt ItemBackpoint{} -> Context ctx posMark elem altHelp -> Maybe ctx -> TokenNum -> RunT ctx posMark elem altHelp m RunningResult goHandleNot Context ctx posMark elem altHelp capturedCtxForFail Maybe ctx mrollbackCustomCtx0 TokenNum alt ItemHandleNot{} -> forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult CantContParse ItemModifyCustomContext ctx customCtx -> Context ctx posMark elem altHelp -> Maybe ctx -> TokenNum -> RunT ctx posMark elem altHelp m RunningResult goHandleNot Context ctx posMark elem altHelp capturedCtxForFail do forall a. a -> Maybe a Just ctx customCtx do TokenNum alt goEnter :: Context ctx posMark elem altHelp -> Maybe ctx -> Parser.AltNum -> Position -> Maybe posMark -> Parser.VarNum -> Parser.StateNum -> RunT ctx posMark elem altHelp m RunningResult goEnter :: Context ctx posMark elem altHelp -> Maybe ctx -> TokenNum -> Position -> Maybe posMark -> TokenNum -> TokenNum -> RunT ctx posMark elem altHelp m RunningResult goEnter Context ctx posMark elem altHelp capturedCtxForFail Maybe ctx mrollbackCustomCtx TokenNum alt Position pos0 Maybe posMark mmark0 TokenNum v TokenNum enterSn = do T ctx elem altHelp parser <- forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> T ctx elem altHelp ctxParser case forall ctx elem altHelp. RunnerParser ctx elem altHelp -> TokenNum -> AltKind Parser.parserAltKind T ctx elem altHelp parser TokenNum alt of AltKind PEG.AltSeq -> forall a. HasCallStack => [Char] -> a error [Char] "unreachable: a not handling with seq alternative" AltKind PEG.AltAnd -> forall a. HasCallStack => [Char] -> a error [Char] "unreachable: a not handling with and alternative" AltKind PEG.AltNot -> forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => TokenNum -> Position -> Maybe ctx -> TokenNum -> [ReduceArgument] -> RunT ctx posMark elem altHelp m Bool runActionAndSaveEnterResult TokenNum v Position pos0 Maybe ctx mrollbackCustomCtx TokenNum alt [] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Bool False -> do forall (m :: * -> *) ctx posMark elem altHelp. Monad m => Context ctx posMark elem altHelp -> RunT ctx posMark elem altHelp m () restoreCtx Context ctx posMark elem altHelp capturedCtxForFail forall ctx posMark elem altHelp (m :: * -> *). T posMark elem m => TokenNum -> RunT ctx posMark elem altHelp m RunningResult parseFailWithAlt TokenNum alt Bool True -> do let mark0 :: posMark mark0 = case Maybe posMark mmark0 of Maybe posMark Nothing -> forall a. HasCallStack => [Char] -> a error [Char] "unreachable: no mark with not alternative" Just posMark x -> posMark x forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => Position -> posMark -> RunT ctx posMark elem altHelp m () seekToMark Position pos0 posMark mark0 forall (m :: * -> *) ctx posMark elem altHelp. Monad m => TokenNum -> RunT ctx posMark elem altHelp m () setNextState TokenNum enterSn forall (f :: * -> *) a. Applicative f => a -> f a pure RunningResult ContParse runActionAndSaveEnterResult :: Scanner.T posMark elem m => Parser.VarNum -> Position -> Maybe ctx -> Parser.AltNum -> [Parser.ReduceArgument] -> RunT ctx posMark elem altHelp m Bool runActionAndSaveEnterResult :: forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => TokenNum -> Position -> Maybe ctx -> TokenNum -> [ReduceArgument] -> RunT ctx posMark elem altHelp m Bool runActionAndSaveEnterResult TokenNum v Position pos0 Maybe ctx mrollbackCustomCtx TokenNum alt [ReduceArgument] args = forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => TokenNum -> [ReduceArgument] -> RunT ctx posMark elem altHelp m (ActionTaskResult ctx ReduceArgument) runAction TokenNum alt [ReduceArgument] args forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case ActionTaskResult ctx ReduceArgument Syntax.ActionTaskFail -> forall (f :: * -> *) a. Applicative f => a -> f a pure Bool False Syntax.ActionTaskResult ReduceArgument res -> do forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => TokenNum -> Position -> Maybe ctx -> Maybe ctx -> ReduceArgument -> RunT ctx posMark elem altHelp m () saveParsedEnterAction TokenNum v Position pos0 Maybe ctx mrollbackCustomCtx forall a. Maybe a Nothing ReduceArgument res forall (f :: * -> *) a. Applicative f => a -> f a pure Bool True Syntax.ActionTaskModifyResult ctx ctx1 ReduceArgument res -> do forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => TokenNum -> Position -> Maybe ctx -> Maybe ctx -> ReduceArgument -> RunT ctx posMark elem altHelp m () saveParsedEnterAction TokenNum v Position pos0 Maybe ctx mrollbackCustomCtx (forall a. a -> Maybe a Just ctx ctx1) ReduceArgument res forall (f :: * -> *) a. Applicative f => a -> f a pure Bool True runAction :: Scanner.T posMark elem m => Parser.AltNum -> [Parser.ReduceArgument] -> RunT ctx posMark elem altHelp m (Syntax.ActionTaskResult ctx Parser.ReduceArgument) runAction :: forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => TokenNum -> [ReduceArgument] -> RunT ctx posMark elem altHelp m (ActionTaskResult ctx ReduceArgument) runAction TokenNum alt [ReduceArgument] args = do T ctx elem altHelp parser <- forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> T ctx elem altHelp ctxParser ctx ctx0 <- forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> ctx ctxCustomContext let actionTask :: ActionTask ctx ReduceArgument actionTask = forall ctx. ActionM ctx -> [ReduceArgument] -> ActionTask ctx ReduceArgument Parser.runActionM do forall ctx elem altHelp. RunnerParser ctx elem altHelp -> TokenNum -> ActionM ctx Parser.parserAction T ctx elem altHelp parser TokenNum alt do [ReduceArgument] args forall (f :: * -> *) a. Applicative f => a -> f a pure do forall ctx a. ActionTask ctx a -> ctx -> ActionTaskResult ctx a Syntax.runActionTask ActionTask ctx ReduceArgument actionTask ctx ctx0 saveParsedEnterAction :: Scanner.T posMark elem m => Parser.VarNum -> Position -> Maybe ctx -> Maybe ctx -> Parser.ReduceArgument -> RunT ctx posMark elem altHelp m () saveParsedEnterAction :: forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => TokenNum -> Position -> Maybe ctx -> Maybe ctx -> ReduceArgument -> RunT ctx posMark elem altHelp m () saveParsedEnterAction TokenNum v Position pos0 Maybe ctx mrollbackCustomCtx Maybe ctx mactionCustomCtx ReduceArgument res = do forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ Maybe ctx mrollbackCustomCtx \ctx customCtx -> do Bool needBack <- forall (m :: * -> *) ctx posMark elem altHelp. Monad m => RunT ctx posMark elem altHelp m Bool isNeedBack forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool needBack do forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => Item posMark ctx -> RunT ctx posMark elem altHelp m () pushItem do forall posMark ctx. ctx -> Item posMark ctx ItemModifyCustomContext ctx customCtx case Maybe ctx mactionCustomCtx of Just ctx customCtx -> forall (m :: * -> *) ctx posMark elem altHelp. Monad m => ctx -> RunT ctx posMark elem altHelp m () updateCustomContext ctx customCtx Maybe ctx Nothing -> forall (m :: * -> *) ctx posMark elem altHelp. Monad m => TokenNum -> Position -> RunT ctx posMark elem altHelp m (MemoItem posMark) -> RunT ctx posMark elem altHelp m () insertMemoItemIfNeeded TokenNum v Position pos0 do (Position pos1, posMark pm1) <- forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => RunT ctx posMark elem altHelp m (Position, posMark) getCurrentPosition forall (f :: * -> *) a. Applicative f => a -> f a pure do forall posMark. Position -> posMark -> ReduceArgument -> MemoItem posMark MemoItemParsed Position pos1 posMark pm1 ReduceArgument res forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => Item posMark ctx -> RunT ctx posMark elem altHelp m () pushItem do forall posMark ctx. ReduceArgument -> Item posMark ctx ItemArgument ReduceArgument res saveFailedEnterAction :: Monad m => Parser.VarNum -> Position -> RunT ctx posMark elem altHelp m () saveFailedEnterAction :: forall (m :: * -> *) ctx posMark elem altHelp. Monad m => TokenNum -> Position -> RunT ctx posMark elem altHelp m () saveFailedEnterAction TokenNum v Position pos = forall (m :: * -> *) ctx posMark elem altHelp. Monad m => TokenNum -> Position -> RunT ctx posMark elem altHelp m (MemoItem posMark) -> RunT ctx posMark elem altHelp m () insertMemoItemIfNeeded TokenNum v Position pos do forall (f :: * -> *) a. Applicative f => a -> f a pure forall posMark. MemoItem posMark MemoItemFailed reportError :: Scanner.T posMark elem m => FailedReason altHelp -> RunT ctx posMark elem altHelp m () reportError :: forall posMark elem (m :: * -> *) altHelp ctx. T posMark elem m => FailedReason altHelp -> RunT ctx posMark elem altHelp m () reportError FailedReason altHelp failedReason = do (Position pos0, posMark posMark0) <- forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => RunT ctx posMark elem altHelp m (Position, posMark) getCurrentPosition forall ctx posMark elem altHelp (m :: * -> *) a. StateT (Context ctx posMark elem altHelp) m a -> RunT ctx posMark elem altHelp m a RunT do forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m () modify' \Context ctx posMark elem altHelp ctx -> Context ctx posMark elem altHelp ctx { $sel:ctxDeepestError:Context :: Maybe (Position, posMark, FailedReason altHelp) ctxDeepestError = case forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> Maybe (Position, posMark, FailedReason altHelp) ctxDeepestError Context ctx posMark elem altHelp ctx of oldErr :: Maybe (Position, posMark, FailedReason altHelp) oldErr@(Just (Position pos1, posMark _, FailedReason altHelp _)) | Position pos0 forall a. Ord a => a -> a -> Bool < Position pos1 -> Maybe (Position, posMark, FailedReason altHelp) oldErr Maybe (Position, posMark, FailedReason altHelp) _ -> forall a. a -> Maybe a Just (Position pos0, posMark posMark0, FailedReason altHelp failedReason) } insertMemoItemIfNeeded :: Monad m => Parser.VarNum -> Position -> RunT ctx posMark elem altHelp m (MemoItem posMark) -> RunT ctx posMark elem altHelp m () insertMemoItemIfNeeded :: forall (m :: * -> *) ctx posMark elem altHelp. Monad m => TokenNum -> Position -> RunT ctx posMark elem altHelp m (MemoItem posMark) -> RunT ctx posMark elem altHelp m () insertMemoItemIfNeeded TokenNum v Position pos RunT ctx posMark elem altHelp m (MemoItem posMark) mitem = do Bool needBack <- forall (m :: * -> *) ctx posMark elem altHelp. Monad m => RunT ctx posMark elem altHelp m Bool isNeedBack forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool needBack do MemoItem posMark memoItem <- RunT ctx posMark elem altHelp m (MemoItem posMark) mitem forall ctx posMark elem altHelp (m :: * -> *) a. StateT (Context ctx posMark elem altHelp) m a -> RunT ctx posMark elem altHelp m a RunT do forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m () modify' \Context ctx posMark elem altHelp ctx -> Context ctx posMark elem altHelp ctx { $sel:ctxMemoTable:Context :: T Position (IntMap (MemoItem posMark)) ctxMemoTable = forall n a. T n => n -> a -> Map n a -> Map n a AlignableMap.insert Position pos do case forall n a. T n => n -> Map n a -> Maybe a AlignableMap.lookup Position pos do forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> T Position (IntMap (MemoItem posMark)) ctxMemoTable Context ctx posMark elem altHelp ctx of Maybe (IntMap (MemoItem posMark)) Nothing -> forall a. TokenNum -> a -> IntMap a IntMap.singleton TokenNum v MemoItem posMark memoItem Just IntMap (MemoItem posMark) vm -> forall a. TokenNum -> a -> IntMap a -> IntMap a IntMap.insert TokenNum v MemoItem posMark memoItem IntMap (MemoItem posMark) vm do forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> T Position (IntMap (MemoItem posMark)) ctxMemoTable Context ctx posMark elem altHelp ctx } updateCustomContext :: Monad m => ctx -> RunT ctx posMark elem altHelp m () updateCustomContext :: forall (m :: * -> *) ctx posMark elem altHelp. Monad m => ctx -> RunT ctx posMark elem altHelp m () updateCustomContext ctx customCtx = forall ctx posMark elem altHelp (m :: * -> *) a. StateT (Context ctx posMark elem altHelp) m a -> RunT ctx posMark elem altHelp m a RunT do forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m () modify' \Context ctx posMark elem altHelp ctx -> Context ctx posMark elem altHelp ctx { $sel:ctxMemoTable:Context :: T Position (IntMap (MemoItem posMark)) ctxMemoTable = forall {k} (n :: k) a. Map n a AlignableMap.empty , $sel:ctxCustomContext:Context :: ctx ctxCustomContext = ctx customCtx } setNextState :: Monad m => Parser.StateNum -> RunT ctx posMark elem altHelp m () setNextState :: forall (m :: * -> *) ctx posMark elem altHelp. Monad m => TokenNum -> RunT ctx posMark elem altHelp m () setNextState TokenNum sn = forall ctx posMark elem altHelp (m :: * -> *) a. StateT (Context ctx posMark elem altHelp) m a -> RunT ctx posMark elem altHelp m a RunT do forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m () modify' \Context ctx posMark elem altHelp ctx -> Context ctx posMark elem altHelp ctx { $sel:ctxState:Context :: TokenNum ctxState = TokenNum sn } getCtx :: Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx :: forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx Context ctx posMark elem altHelp -> a f = forall ctx posMark elem altHelp (m :: * -> *) a. StateT (Context ctx posMark elem altHelp) m a -> RunT ctx posMark elem altHelp m a RunT do Context ctx posMark elem altHelp -> a f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) s. Monad m => StateT s m s get {-# INLINE getCtx #-} captureCtx :: Monad m => RunT ctx posMark elem altHelp m (Context ctx posMark elem altHelp) captureCtx :: forall (m :: * -> *) ctx posMark elem altHelp. Monad m => RunT ctx posMark elem altHelp m (Context ctx posMark elem altHelp) captureCtx = forall ctx posMark elem altHelp (m :: * -> *) a. StateT (Context ctx posMark elem altHelp) m a -> RunT ctx posMark elem altHelp m a RunT forall (m :: * -> *) s. Monad m => StateT s m s get restoreCtx :: Monad m => Context ctx posMark elem altHelp -> RunT ctx posMark elem altHelp m () restoreCtx :: forall (m :: * -> *) ctx posMark elem altHelp. Monad m => Context ctx posMark elem altHelp -> RunT ctx posMark elem altHelp m () restoreCtx Context ctx posMark elem altHelp ctx = forall ctx posMark elem altHelp (m :: * -> *) a. StateT (Context ctx posMark elem altHelp) m a -> RunT ctx posMark elem altHelp m a RunT do forall (m :: * -> *) s. Monad m => s -> StateT s m () put Context ctx posMark elem altHelp ctx getCurrentPosition :: Scanner.T posMark elem m => RunT ctx posMark elem altHelp m (Position, posMark) getCurrentPosition :: forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => RunT ctx posMark elem altHelp m (Position, posMark) getCurrentPosition = forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> Maybe (Position, posMark, TokenNum, Maybe elem) ctxLookAHeadToken forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Just (Position pos, posMark pm, TokenNum _, Maybe elem _) -> forall (f :: * -> *) a. Applicative f => a -> f a pure (Position pos, posMark pm) Maybe (Position, posMark, TokenNum, Maybe elem) Nothing -> do posMark pm <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift forall posMark elem (m :: * -> *). Scanner posMark elem m => m posMark Scanner.getPosMark Position pos <- forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> Position ctxNextPosition forall (f :: * -> *) a. Applicative f => a -> f a pure (Position pos, posMark pm) consumeIfNeeded :: Scanner.T posMark elem m => RunT ctx posMark elem altHelp m (Parser.TokenNum, Maybe elem) consumeIfNeeded :: forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => RunT ctx posMark elem altHelp m (TokenNum, Maybe elem) consumeIfNeeded = forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> Maybe (Position, posMark, TokenNum, Maybe elem) ctxLookAHeadToken forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Just (Position _, posMark _, TokenNum tn, Maybe elem mt) -> forall (f :: * -> *) a. Applicative f => a -> f a pure (TokenNum tn, Maybe elem mt) Maybe (Position, posMark, TokenNum, Maybe elem) Nothing -> do posMark pm <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift forall posMark elem (m :: * -> *). Scanner posMark elem m => m posMark Scanner.getPosMark r :: (TokenNum, Maybe elem) r@(TokenNum tn, Maybe elem mt) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift forall posMark elem (m :: * -> *). Scanner posMark elem m => m (Maybe elem) Scanner.consumeInput forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Maybe elem Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a pure (TokenNum Parser.eosToken, forall a. Maybe a Nothing) Just elem t -> do T ctx elem altHelp parser <- forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> T ctx elem altHelp ctxParser let tn :: TokenNum tn = forall ctx elem altHelp. RunnerParser ctx elem altHelp -> elem -> TokenNum Parser.parserGetTokenNum T ctx elem altHelp parser elem t forall (f :: * -> *) a. Applicative f => a -> f a pure (TokenNum tn, forall a. a -> Maybe a Just elem t) forall ctx posMark elem altHelp (m :: * -> *) a. StateT (Context ctx posMark elem altHelp) m a -> RunT ctx posMark elem altHelp m a RunT do forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m () modify' \Context ctx posMark elem altHelp ctx -> Context ctx posMark elem altHelp ctx { $sel:ctxNextPosition:Context :: Position ctxNextPosition = forall i. Alignable i => i -> i Alignable.nextAlign do forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> Position ctxNextPosition Context ctx posMark elem altHelp ctx , $sel:ctxLookAHeadToken:Context :: Maybe (Position, posMark, TokenNum, Maybe elem) ctxLookAHeadToken = forall a. a -> Maybe a Just (forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> Position ctxNextPosition Context ctx posMark elem altHelp ctx, posMark pm, TokenNum tn, Maybe elem mt) } forall (f :: * -> *) a. Applicative f => a -> f a pure (TokenNum, Maybe elem) r shift :: Monad m => RunT ctx posMark elem altHelp m () shift :: forall (m :: * -> *) ctx posMark elem altHelp. Monad m => RunT ctx posMark elem altHelp m () shift = forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> Maybe (Position, posMark, TokenNum, Maybe elem) ctxLookAHeadToken forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Maybe (Position, posMark, TokenNum, Maybe elem) Nothing -> forall a. HasCallStack => [Char] -> a error [Char] "Must consume before shift" Just (Position _, posMark _, TokenNum _, Maybe elem Nothing) -> forall a. HasCallStack => [Char] -> a error [Char] "No more shift" Just (Position _, posMark _, TokenNum _, Just{}) -> forall ctx posMark elem altHelp (m :: * -> *) a. StateT (Context ctx posMark elem altHelp) m a -> RunT ctx posMark elem altHelp m a RunT do forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m () modify' \Context ctx posMark elem altHelp ctx -> Context ctx posMark elem altHelp ctx { $sel:ctxLookAHeadToken:Context :: Maybe (Position, posMark, TokenNum, Maybe elem) ctxLookAHeadToken = forall a. Maybe a Nothing } seekToMark :: Scanner.T posMark elem m => Position -> posMark -> RunT ctx posMark elem altHelp m () seekToMark :: forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => Position -> posMark -> RunT ctx posMark elem altHelp m () seekToMark Position pos posMark pm = do forall ctx posMark elem altHelp (m :: * -> *) a. StateT (Context ctx posMark elem altHelp) m a -> RunT ctx posMark elem altHelp m a RunT do forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m () modify' \Context ctx posMark elem altHelp ctx -> Context ctx posMark elem altHelp ctx { $sel:ctxLookAHeadToken:Context :: Maybe (Position, posMark, TokenNum, Maybe elem) ctxLookAHeadToken = forall a. Maybe a Nothing , $sel:ctxNextPosition:Context :: Position ctxNextPosition = Position pos } forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift do forall posMark elem (m :: * -> *). Scanner posMark elem m => posMark -> m () Scanner.seekToPosMark posMark pm isNeedBack :: Monad m => RunT ctx posMark elem altHelp m Bool isNeedBack :: forall (m :: * -> *) ctx posMark elem altHelp. Monad m => RunT ctx posMark elem altHelp m Bool isNeedBack = do TokenNum needBackItemsCount <- forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> TokenNum ctxNeedBackItemsCount forall (f :: * -> *) a. Applicative f => a -> f a pure do TokenNum needBackItemsCount forall a. Ord a => a -> a -> Bool > TokenNum 0 pushItem :: Scanner.T posMark elem m => Item posMark ctx -> RunT ctx posMark elem altHelp m () pushItem :: forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => Item posMark ctx -> RunT ctx posMark elem altHelp m () pushItem Item posMark ctx item = do (Position pos, posMark p) <- forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => RunT ctx posMark elem altHelp m (Position, posMark) getCurrentPosition TokenNum bc0 <- forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> TokenNum ctxNeedBackItemsCount let bc1 :: TokenNum bc1 = if forall posMark ctx. Item posMark ctx -> Bool isNeedBackItem Item posMark ctx item then TokenNum bc0 forall a. Num a => a -> a -> a + TokenNum 1 else TokenNum bc0 forall (f :: * -> *). Applicative f => Bool -> f () -> f () when do TokenNum bc0 forall a. Eq a => a -> a -> Bool == TokenNum 0 Bool -> Bool -> Bool && TokenNum bc1 forall a. Ord a => a -> a -> Bool > TokenNum 0 do forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift do forall posMark elem (m :: * -> *). Scanner posMark elem m => ScanMode posMark -> m () Scanner.scanMode do forall posMark. posMark -> ScanMode posMark Scanner.ScanModeNeedBack posMark p forall ctx posMark elem altHelp (m :: * -> *) a. StateT (Context ctx posMark elem altHelp) m a -> RunT ctx posMark elem altHelp m a RunT do forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m () modify' \Context ctx posMark elem altHelp ctx -> Context ctx posMark elem altHelp ctx { $sel:ctxItemStack:Context :: [Item posMark ctx] ctxItemStack = Item posMark ctx itemforall a. a -> [a] -> [a] :forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> [Item posMark ctx] ctxItemStack Context ctx posMark elem altHelp ctx , $sel:ctxNeedBackItemsCount:Context :: TokenNum ctxNeedBackItemsCount = TokenNum bc1 , $sel:ctxMemoTable:Context :: T Position (IntMap (MemoItem posMark)) ctxMemoTable = if TokenNum bc0 forall a. Eq a => a -> a -> Bool == TokenNum 0 Bool -> Bool -> Bool && TokenNum bc1 forall a. Ord a => a -> a -> Bool > TokenNum 0 then do forall n a. T n => n -> Map n a -> Map n a AlignableMap.restrictGreaterOrEqual do Position pos do forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> T Position (IntMap (MemoItem posMark)) ctxMemoTable Context ctx posMark elem altHelp ctx else forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> T Position (IntMap (MemoItem posMark)) ctxMemoTable Context ctx posMark elem altHelp ctx } popItem :: Scanner.T posMark elem m => RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx)) popItem :: forall posMark elem (m :: * -> *) ctx altHelp. T posMark elem m => RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx)) popItem = forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> [Item posMark ctx] ctxItemStack forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case [] -> forall (f :: * -> *) a. Applicative f => a -> f a pure forall a. Maybe a Nothing Item posMark ctx item:[Item posMark ctx] rest -> do TokenNum bc0 <- forall (m :: * -> *) ctx posMark elem altHelp a. Monad m => (Context ctx posMark elem altHelp -> a) -> RunT ctx posMark elem altHelp m a getCtx forall ctx posMark elem altHelp. Context ctx posMark elem altHelp -> TokenNum ctxNeedBackItemsCount let bc1 :: TokenNum bc1 = if forall posMark ctx. Item posMark ctx -> Bool isNeedBackItem Item posMark ctx item then TokenNum bc0 forall a. Num a => a -> a -> a - TokenNum 1 else TokenNum bc0 forall (f :: * -> *). Applicative f => Bool -> f () -> f () when do TokenNum bc1 forall a. Eq a => a -> a -> Bool == TokenNum 0 do forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift do forall posMark elem (m :: * -> *). Scanner posMark elem m => ScanMode posMark -> m () Scanner.scanMode forall posMark. ScanMode posMark Scanner.ScanModeNoBack forall ctx posMark elem altHelp (m :: * -> *) a. StateT (Context ctx posMark elem altHelp) m a -> RunT ctx posMark elem altHelp m a RunT do forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m () modify' \Context ctx posMark elem altHelp ctx -> Context ctx posMark elem altHelp ctx { $sel:ctxItemStack:Context :: [Item posMark ctx] ctxItemStack = [Item posMark ctx] rest , $sel:ctxNeedBackItemsCount:Context :: TokenNum ctxNeedBackItemsCount = TokenNum bc1 } forall (f :: * -> *) a. Applicative f => a -> f a pure do forall a. a -> Maybe a Just Item posMark ctx item isNeedBackItem :: Item posMark ctx -> Bool isNeedBackItem :: forall posMark ctx. Item posMark ctx -> Bool isNeedBackItem = \case ItemHandleNot{} -> Bool False ItemBackpoint{} -> Bool True ItemModifyCustomContext{} -> Bool False ItemEnter Position _ Maybe posMark mmark TokenNum _ TokenNum _ -> case Maybe posMark mmark of Maybe posMark Nothing -> Bool False Just{} -> Bool True ItemArgument{} -> Bool False