{-# 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