{-# 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
    {
        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 a
-> RunT ctx posMark elem altHelp m b
-> RunT ctx posMark elem altHelp m a
(a -> b)
-> RunT ctx posMark elem altHelp m a
-> RunT ctx posMark elem altHelp m b
(forall a b.
 (a -> b)
 -> RunT ctx posMark elem altHelp m a
 -> RunT ctx posMark elem altHelp m b)
-> (forall a b.
    a
    -> RunT ctx posMark elem altHelp m b
    -> RunT ctx posMark elem altHelp m a)
-> Functor (RunT ctx posMark elem altHelp m)
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
<$ :: 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 :: (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 (
        Functor (RunT ctx posMark elem altHelp m)
a -> RunT ctx posMark elem altHelp m a
Functor (RunT ctx posMark elem altHelp m)
-> (forall a. a -> RunT ctx posMark elem altHelp m a)
-> (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 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
    -> RunT ctx posMark elem altHelp m b
    -> RunT ctx posMark elem altHelp m a)
-> Applicative (RunT ctx posMark elem altHelp m)
RunT ctx posMark elem altHelp m a
-> RunT ctx posMark elem altHelp m b
-> RunT ctx posMark elem altHelp m b
RunT ctx posMark elem altHelp m a
-> RunT ctx posMark elem altHelp m b
-> RunT ctx posMark elem altHelp m a
RunT ctx posMark elem altHelp m (a -> b)
-> RunT ctx posMark elem altHelp m a
-> RunT ctx posMark elem altHelp m b
(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. 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
<* :: 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
*> :: 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 :: (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
<*> :: 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 :: 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
$cp1Applicative :: forall ctx posMark elem altHelp (m :: * -> *).
Monad m =>
Functor (RunT ctx posMark elem altHelp m)
Applicative,
        Applicative (RunT ctx posMark elem altHelp m)
a -> RunT ctx posMark elem altHelp m a
Applicative (RunT ctx posMark elem altHelp m)
-> (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 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. a -> RunT ctx posMark elem altHelp m a)
-> Monad (RunT ctx posMark elem altHelp m)
RunT ctx posMark elem altHelp m a
-> (a -> RunT ctx posMark elem altHelp m b)
-> RunT ctx posMark elem altHelp m b
RunT ctx posMark elem altHelp m a
-> RunT ctx posMark elem altHelp m b
-> RunT ctx posMark elem altHelp m b
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 :: 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
>> :: 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
>>= :: 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
$cp1Monad :: forall ctx posMark elem altHelp (m :: * -> *).
Monad m =>
Applicative (RunT ctx posMark elem altHelp m)
Monad
    ) via (StateT (Context ctx posMark elem altHelp) m)

instance MonadTrans (RunT ctx posMark elem altHelp) where
    lift :: m a -> RunT ctx posMark elem altHelp m a
lift m a
mx = StateT (Context ctx posMark elem altHelp) m a
-> RunT ctx posMark elem altHelp m a
forall ctx posMark elem altHelp (m :: * -> *) a.
StateT (Context ctx posMark elem altHelp) m a
-> RunT ctx posMark elem altHelp m a
RunT do m a -> StateT (Context ctx posMark elem altHelp) m a
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 :: 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
_) <- RunT ctx posMark elem altHelp m (TokenNum, Maybe elem)
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
RunT ctx posMark elem altHelp m (TokenNum, Maybe elem)
consumeIfNeeded
        TokenNum
sn <- (Context ctx posMark elem altHelp -> TokenNum)
-> RunT ctx posMark elem altHelp m TokenNum
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 -> TokenNum
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp -> TokenNum
ctxState
        if TokenNum
sn TokenNum -> TokenNum -> Bool
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 TokenNum -> RunT ctx posMark elem altHelp m RunningResult
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
-> (RunningResult
    -> RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a))
-> RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a)
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 = (Context ctx posMark elem altHelp -> [Item posMark ctx])
-> RunT ctx posMark elem altHelp m [Item posMark ctx]
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 -> [Item posMark ctx]
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp -> [Item posMark ctx]
ctxItemStack RunT ctx posMark elem altHelp m [Item posMark ctx]
-> ([Item posMark ctx]
    -> RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a))
-> RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        [ItemArgument (Parser.ReduceArgument a
x)] ->
            ParseResult posMark altHelp a
-> RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure do a -> ParseResult posMark altHelp a
forall posMark altHelp a. a -> ParseResult posMark altHelp a
Parsed do a -> a
forall a b. a -> b
Unsafe.unsafeCoerce a
x
        [Item posMark ctx]
_ -> do
            if TokenNum
tok TokenNum -> TokenNum -> Bool
forall a. Ord a => a -> a -> Bool
>= TokenNum
0
                then FailedReason altHelp -> RunT ctx posMark elem altHelp m ()
forall posMark elem (m :: * -> *) altHelp ctx.
T posMark elem m =>
FailedReason altHelp -> RunT ctx posMark elem altHelp m ()
reportError FailedReason altHelp
forall altHelp. FailedReason altHelp
FailedByEarlyParsed
                else FailedReason altHelp -> RunT ctx posMark elem altHelp m ()
forall posMark elem (m :: * -> *) altHelp ctx.
T posMark elem m =>
FailedReason altHelp -> RunT ctx posMark elem altHelp m ()
reportError FailedReason altHelp
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 = (Context ctx posMark elem altHelp
 -> Maybe (Position, posMark, FailedReason altHelp))
-> RunT
     ctx
     posMark
     elem
     altHelp
     m
     (Maybe (Position, posMark, FailedReason altHelp))
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
-> Maybe (Position, posMark, FailedReason altHelp)
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp
-> Maybe (Position, posMark, FailedReason altHelp)
ctxDeepestError RunT
  ctx
  posMark
  elem
  altHelp
  m
  (Maybe (Position, posMark, FailedReason altHelp))
-> (Maybe (Position, posMark, FailedReason altHelp)
    -> RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a))
-> RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just (Position
_, posMark
posMark0, FailedReason altHelp
failedReason) ->
            ParseResult posMark altHelp a
-> RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure do posMark -> FailedReason altHelp -> ParseResult posMark altHelp a
forall posMark altHelp a.
posMark -> FailedReason altHelp -> ParseResult posMark altHelp a
ParseFailed posMark
posMark0 FailedReason altHelp
failedReason
        Maybe (Position, posMark, FailedReason altHelp)
Nothing ->
            [Char]
-> RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a)
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
[ParseResult posMark altHelp a] -> ShowS
ParseResult posMark altHelp a -> [Char]
(TokenNum -> ParseResult posMark altHelp a -> ShowS)
-> (ParseResult posMark altHelp a -> [Char])
-> ([ParseResult posMark altHelp a] -> ShowS)
-> Show (ParseResult posMark altHelp a)
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, a -> ParseResult posMark altHelp b -> ParseResult posMark altHelp a
(a -> b)
-> ParseResult posMark altHelp a -> ParseResult posMark altHelp b
(forall a b.
 (a -> b)
 -> ParseResult posMark altHelp a -> ParseResult posMark altHelp b)
-> (forall a b.
    a
    -> ParseResult posMark altHelp b -> ParseResult posMark altHelp a)
-> Functor (ParseResult posMark altHelp)
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
<$ :: 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 :: (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
[FailedReason altHelp] -> ShowS
FailedReason altHelp -> [Char]
(TokenNum -> FailedReason altHelp -> ShowS)
-> (FailedReason altHelp -> [Char])
-> ([FailedReason altHelp] -> ShowS)
-> Show (FailedReason altHelp)
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, a -> FailedReason b -> FailedReason a
(a -> b) -> FailedReason a -> FailedReason b
(forall a b. (a -> b) -> FailedReason a -> FailedReason b)
-> (forall a b. a -> FailedReason b -> FailedReason a)
-> Functor FailedReason
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
<$ :: a -> FailedReason b -> FailedReason a
$c<$ :: forall a b. a -> FailedReason b -> FailedReason a
fmap :: (a -> b) -> FailedReason a -> FailedReason b
$cfmap :: forall a b. (a -> b) -> FailedReason a -> FailedReason b
Functor)

data Context ctx posMark elem altHelp = Context
    { Context ctx posMark elem altHelp -> T ctx elem altHelp
ctxParser             :: Parser.T ctx elem altHelp
    , Context ctx posMark elem altHelp -> TokenNum
ctxState              :: Parser.StateNum
    , Context ctx posMark elem altHelp -> [Item posMark ctx]
ctxItemStack          :: [Item posMark ctx]
    , Context ctx posMark elem altHelp
-> Maybe (Position, posMark, TokenNum, Maybe elem)
ctxLookAHeadToken     :: Maybe (Position, posMark, Parser.TokenNum, Maybe elem)
    , Context ctx posMark elem altHelp -> Position
ctxNextPosition       :: Position
    , Context ctx posMark elem altHelp
-> Maybe (Position, posMark, FailedReason altHelp)
ctxDeepestError       :: Maybe (Position, posMark, FailedReason altHelp)
    , Context ctx posMark elem altHelp
-> T Position (IntMap (MemoItem posMark))
ctxMemoTable          :: AlignableMap.T Position (IntMap.IntMap (MemoItem posMark))
    , Context ctx posMark elem altHelp -> TokenNum
ctxNeedBackItemsCount :: Int
    , Context ctx posMark elem altHelp -> ctx
ctxCustomContext      :: ctx
    }

newtype Position = Position Int
    deriving (Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
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
Eq Position
-> (Position -> Position -> Ordering)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Position)
-> (Position -> Position -> Position)
-> Ord 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
$cp1Ord :: Eq Position
Ord, TokenNum -> Position -> ShowS
[Position] -> ShowS
Position -> [Char]
(TokenNum -> Position -> ShowS)
-> (Position -> [Char]) -> ([Position] -> ShowS) -> Show Position
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
Coercible TokenNum Position -> Alignable 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
(RunningResult -> RunningResult -> Bool)
-> (RunningResult -> RunningResult -> Bool) -> Eq RunningResult
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]
(TokenNum -> RunningResult -> ShowS)
-> (RunningResult -> [Char])
-> ([RunningResult] -> ShowS)
-> Show RunningResult
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 :: 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 <- T ctx elem altHelp -> TokenNum -> Maybe TokenNum
forall ctx elem altHelp.
RunnerParser ctx elem altHelp -> TokenNum -> Maybe TokenNum
Parser.parserInitial T ctx elem altHelp
parser TokenNum
s0
    Context ctx posMark elem altHelp
-> Maybe (Context ctx posMark elem altHelp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure do
        Context :: forall ctx posMark elem altHelp.
T ctx elem altHelp
-> TokenNum
-> [Item posMark ctx]
-> Maybe (Position, posMark, TokenNum, Maybe elem)
-> Position
-> Maybe (Position, posMark, FailedReason altHelp)
-> T Position (IntMap (MemoItem posMark))
-> TokenNum
-> ctx
-> Context ctx posMark elem altHelp
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 = Maybe (Position, posMark, TokenNum, Maybe elem)
forall a. Maybe a
Nothing
            , $sel:ctxItemStack:Context :: [Item posMark ctx]
ctxItemStack = []
            , $sel:ctxNextPosition:Context :: Position
ctxNextPosition = Position
forall i. Alignable i => i
Alignable.initialAlign
            , $sel:ctxMemoTable:Context :: T Position (IntMap (MemoItem posMark))
ctxMemoTable = T Position (IntMap (MemoItem posMark))
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 = Maybe (Position, posMark, FailedReason altHelp)
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 :: 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 <- (Context ctx posMark elem altHelp -> T ctx elem altHelp)
-> RunT ctx posMark elem altHelp m (T ctx elem altHelp)
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 -> T ctx elem altHelp
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp -> T ctx elem altHelp
ctxParser
        TokenNum
sn0 <- (Context ctx posMark elem altHelp -> TokenNum)
-> RunT ctx posMark elem altHelp m TokenNum
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 -> TokenNum
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp -> TokenNum
ctxState
        let trans1 :: Trans
trans1 = T ctx elem altHelp -> TokenNum -> TokenNum -> Trans
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
        TokenNum -> RunT ctx posMark elem altHelp m ()
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 TokenNum -> TokenNum -> Bool
forall a. Ord a => a -> a -> Bool
< TokenNum
0 ->
                    TokenNum -> RunT ctx posMark elem altHelp m RunningResult
forall ctx posMark elem altHelp (m :: * -> *).
T posMark elem m =>
TokenNum -> RunT ctx posMark elem altHelp m RunningResult
parseFailWithState TokenNum
sn0
                | Bool
otherwise ->
                    RunningResult -> RunT ctx posMark elem altHelp m RunningResult
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
        [] ->
            RunningResult -> RunT ctx posMark elem altHelp m RunningResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunningResult
ContParse
        TransOp
op:[TransOp]
ops -> do
            RunningResult
result <- TransOp -> RunT ctx posMark elem altHelp m RunningResult
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 ->
                    RunningResult -> RunT ctx posMark elem altHelp m RunningResult
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 :: TransOp -> RunT ctx posMark elem altHelp m RunningResult
runTransOp = \case
    Parser.TransOpEnter TokenNum
v Bool
needBack TokenNum
enterSn ->
        TokenNum
-> Bool
-> TokenNum
-> RunT ctx posMark elem altHelp m RunningResult
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) <- RunT ctx posMark elem altHelp m (Position, posMark)
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
RunT ctx posMark elem altHelp m (Position, posMark)
getCurrentPosition
        Item posMark ctx -> RunT ctx posMark elem altHelp m ()
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
Item posMark ctx -> RunT ctx posMark elem altHelp m ()
pushItem do Position -> posMark -> TokenNum -> Item posMark ctx
forall posMark ctx.
Position -> posMark -> TokenNum -> Item posMark ctx
ItemBackpoint Position
pos posMark
mark TokenNum
backSn
        RunningResult -> RunT ctx posMark elem altHelp m RunningResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunningResult
ContParse
    Parser.TransOpHandleNot TokenNum
alt -> do
        Item posMark ctx -> RunT ctx posMark elem altHelp m ()
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
Item posMark ctx -> RunT ctx posMark elem altHelp m ()
pushItem do TokenNum -> Item posMark ctx
forall posMark ctx. TokenNum -> Item posMark ctx
ItemHandleNot TokenNum
alt
        RunningResult -> RunT ctx posMark elem altHelp m RunningResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunningResult
ContParse
    TransOp
Parser.TransOpShift -> RunT ctx posMark elem altHelp m (TokenNum, Maybe elem)
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
RunT ctx posMark elem altHelp m (TokenNum, Maybe elem)
consumeIfNeeded RunT ctx posMark elem altHelp m (TokenNum, Maybe elem)
-> ((TokenNum, Maybe elem)
    -> RunT ctx posMark elem altHelp m RunningResult)
-> RunT ctx posMark elem altHelp m RunningResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        (TokenNum
_, Maybe elem
Nothing) ->
            Maybe (FailedReason altHelp)
-> RunT ctx posMark elem altHelp m RunningResult
forall ctx posMark elem altHelp (m :: * -> *).
T posMark elem m =>
Maybe (FailedReason altHelp)
-> RunT ctx posMark elem altHelp m RunningResult
parseFail do FailedReason altHelp -> Maybe (FailedReason altHelp)
forall a. a -> Maybe a
Just FailedReason altHelp
forall altHelp. FailedReason altHelp
FailedByNotEnoughInput
        (TokenNum
_, Just elem
x) -> do
            Item posMark ctx -> RunT ctx posMark elem altHelp m ()
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
Item posMark ctx -> RunT ctx posMark elem altHelp m ()
pushItem do ReduceArgument -> Item posMark ctx
forall posMark ctx. ReduceArgument -> Item posMark ctx
ItemArgument do elem -> ReduceArgument
forall a. a -> ReduceArgument
Parser.ReduceArgument elem
x
            RunT ctx posMark elem altHelp m ()
forall (m :: * -> *) ctx posMark elem altHelp.
Monad m =>
RunT ctx posMark elem altHelp m ()
shift
            RunningResult -> RunT ctx posMark elem altHelp m RunningResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunningResult
ContParse
    Parser.TransOpReduce TokenNum
alt ->
        TokenNum -> RunT ctx posMark elem altHelp m RunningResult
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 :: TokenNum
-> Bool
-> TokenNum
-> RunT ctx posMark elem altHelp m RunningResult
runEnter TokenNum
v Bool
needBack TokenNum
enterSn = do
    (Position
pos0, posMark
mark0) <- RunT ctx posMark elem altHelp m (Position, posMark)
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 <- (Context ctx posMark elem altHelp
 -> T Position (IntMap (MemoItem posMark)))
-> RunT
     ctx posMark elem altHelp m (T Position (IntMap (MemoItem posMark)))
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
-> T Position (IntMap (MemoItem posMark))
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp
-> T Position (IntMap (MemoItem posMark))
ctxMemoTable
    let vm :: IntMap (MemoItem posMark)
vm = case Position
-> T Position (IntMap (MemoItem posMark))
-> Maybe (IntMap (MemoItem posMark))
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 -> IntMap (MemoItem posMark)
forall a. IntMap a
IntMap.empty
            Just IntMap (MemoItem posMark)
m  -> IntMap (MemoItem posMark)
m
    case TokenNum -> IntMap (MemoItem posMark) -> Maybe (MemoItem posMark)
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 posMark -> Maybe posMark
forall a. a -> Maybe a
Just posMark
mark0
                    else Maybe posMark
forall a. Maybe a
Nothing
            Item posMark ctx -> RunT ctx posMark elem altHelp m ()
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
Item posMark ctx -> RunT ctx posMark elem altHelp m ()
pushItem do Position
-> Maybe posMark -> TokenNum -> TokenNum -> Item posMark ctx
forall posMark ctx.
Position
-> Maybe posMark -> TokenNum -> TokenNum -> Item posMark ctx
ItemEnter Position
pos0 Maybe posMark
mmark0 TokenNum
v TokenNum
enterSn
            RunningResult -> RunT ctx posMark elem altHelp m RunningResult
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
                TokenNum -> RunT ctx posMark elem altHelp m ()
forall (m :: * -> *) ctx posMark elem altHelp.
Monad m =>
TokenNum -> RunT ctx posMark elem altHelp m ()
setNextState TokenNum
enterSn
                Item posMark ctx -> RunT ctx posMark elem altHelp m ()
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
Item posMark ctx -> RunT ctx posMark elem altHelp m ()
pushItem do ReduceArgument -> Item posMark ctx
forall posMark ctx. ReduceArgument -> Item posMark ctx
ItemArgument ReduceArgument
x
                Position -> posMark -> RunT ctx posMark elem altHelp m ()
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
Position -> posMark -> RunT ctx posMark elem altHelp m ()
seekToMark Position
pos1 posMark
mark1
                RunningResult -> RunT ctx posMark elem altHelp m RunningResult
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
                Maybe (FailedReason altHelp)
-> RunT ctx posMark elem altHelp m RunningResult
forall ctx posMark elem altHelp (m :: * -> *).
T posMark elem m =>
Maybe (FailedReason altHelp)
-> RunT ctx posMark elem altHelp m RunningResult
parseFail Maybe (FailedReason altHelp)
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 :: 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 <- RunT ctx posMark elem altHelp m (Context ctx posMark elem altHelp)
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 Maybe ctx
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 = RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx))
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx))
popItem RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx))
-> (Maybe (Item posMark ctx)
    -> RunT ctx posMark elem altHelp m RunningResult)
-> RunT ctx posMark elem altHelp m RunningResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Item posMark ctx)
Nothing ->
            RunningResult -> RunT ctx posMark elem altHelp m RunningResult
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
xReduceArgument -> [ReduceArgument] -> [ReduceArgument]
forall 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 ctx -> Maybe ctx
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
                Maybe ctx
-> (ctx -> RunT ctx posMark elem altHelp m ())
-> RunT ctx posMark elem altHelp m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ctx
mrollbackCustomCtx0 \ctx
customCtx -> ctx -> RunT ctx posMark elem altHelp m ()
forall (m :: * -> *) ctx posMark elem altHelp.
Monad m =>
ctx -> RunT ctx posMark elem altHelp m ()
updateCustomContext ctx
customCtx
                TokenNum -> RunT ctx posMark elem altHelp m RunningResult
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 <- (Context ctx posMark elem altHelp -> T ctx elem altHelp)
-> RunT ctx posMark elem altHelp m (T ctx elem altHelp)
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 -> T ctx elem altHelp
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp -> T ctx elem altHelp
ctxParser
        case T ctx elem altHelp -> TokenNum -> AltKind
forall ctx elem altHelp.
RunnerParser ctx elem altHelp -> TokenNum -> AltKind
Parser.parserAltKind T ctx elem altHelp
parser TokenNum
alt of
            AltKind
PEG.AltSeq -> TokenNum
-> Position
-> Maybe ctx
-> TokenNum
-> [ReduceArgument]
-> RunT ctx posMark elem altHelp m Bool
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 RunT ctx posMark elem altHelp m Bool
-> (Bool -> RunT ctx posMark elem altHelp m RunningResult)
-> RunT ctx posMark elem altHelp m RunningResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Bool
False -> do
                    Context ctx posMark elem altHelp
-> RunT ctx posMark elem altHelp m ()
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
                    TokenNum -> RunT ctx posMark elem altHelp m RunningResult
forall ctx posMark elem altHelp (m :: * -> *).
T posMark elem m =>
TokenNum -> RunT ctx posMark elem altHelp m RunningResult
parseFailWithAlt TokenNum
alt
                Bool
True -> do
                    TokenNum -> RunT ctx posMark elem altHelp m ()
forall (m :: * -> *) ctx posMark elem altHelp.
Monad m =>
TokenNum -> RunT ctx posMark elem altHelp m ()
setNextState TokenNum
enterSn
                    RunningResult -> RunT ctx posMark elem altHelp m RunningResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunningResult
ContParse
            AltKind
PEG.AltAnd -> TokenNum
-> Position
-> Maybe ctx
-> TokenNum
-> [ReduceArgument]
-> RunT ctx posMark elem altHelp m Bool
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 RunT ctx posMark elem altHelp m Bool
-> (Bool -> RunT ctx posMark elem altHelp m RunningResult)
-> RunT ctx posMark elem altHelp m RunningResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Bool
False -> do
                    Context ctx posMark elem altHelp
-> RunT ctx posMark elem altHelp m ()
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
                    TokenNum -> RunT ctx posMark elem altHelp m RunningResult
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 ->
                                [Char] -> posMark
forall a. HasCallStack => [Char] -> a
error [Char]
"unreachable: no mark with and alternative"
                            Just posMark
x ->
                                posMark
x
                    Position -> posMark -> RunT ctx posMark elem altHelp m ()
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
Position -> posMark -> RunT ctx posMark elem altHelp m ()
seekToMark Position
pos0 posMark
mark0
                    TokenNum -> RunT ctx posMark elem altHelp m ()
forall (m :: * -> *) ctx posMark elem altHelp.
Monad m =>
TokenNum -> RunT ctx posMark elem altHelp m ()
setNextState TokenNum
enterSn
                    RunningResult -> RunT ctx posMark elem altHelp m RunningResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunningResult
ContParse
            AltKind
PEG.AltNot ->
                RunningResult -> RunT ctx posMark elem altHelp m RunningResult
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 :: TokenNum -> RunT ctx posMark elem altHelp m RunningResult
parseFailWithAlt TokenNum
alt = do
    T ctx elem altHelp
parser <- (Context ctx posMark elem altHelp -> T ctx elem altHelp)
-> RunT ctx posMark elem altHelp m (T ctx elem altHelp)
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 -> T ctx elem altHelp
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp -> T ctx elem altHelp
ctxParser
    let ([Char]
varHelp, Maybe altHelp
altHelp) = T ctx elem altHelp -> TokenNum -> ([Char], Maybe altHelp)
forall ctx elem altHelp.
RunnerParser ctx elem altHelp
-> TokenNum -> ([Char], Maybe altHelp)
Parser.parserAltHelp T ctx elem altHelp
parser TokenNum
alt
    Maybe (FailedReason altHelp)
-> RunT ctx posMark elem altHelp m RunningResult
forall ctx posMark elem altHelp (m :: * -> *).
T posMark elem m =>
Maybe (FailedReason altHelp)
-> RunT ctx posMark elem altHelp m RunningResult
parseFail do FailedReason altHelp -> Maybe (FailedReason altHelp)
forall a. a -> Maybe a
Just do [([Char], Maybe altHelp, Maybe TokenNum)] -> FailedReason altHelp
forall altHelp.
[([Char], Maybe altHelp, Maybe TokenNum)] -> FailedReason altHelp
FailedWithHelp [([Char]
varHelp, Maybe altHelp
altHelp, Maybe TokenNum
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 :: TokenNum -> RunT ctx posMark elem altHelp m RunningResult
parseFailWithState TokenNum
sn = do
    T ctx elem altHelp
parser <- (Context ctx posMark elem altHelp -> T ctx elem altHelp)
-> RunT ctx posMark elem altHelp m (T ctx elem altHelp)
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 -> T ctx elem altHelp
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp -> T ctx elem altHelp
ctxParser
    let altItems :: [(TokenNum, TokenNum)]
altItems = T ctx elem altHelp -> TokenNum -> [(TokenNum, TokenNum)]
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
                , TokenNum -> Maybe TokenNum
forall a. a -> Maybe a
Just TokenNum
pos
                )
            | (TokenNum
alt, TokenNum
pos) <- [(TokenNum, TokenNum)]
altItems
            , let ([Char]
varHelp, Maybe altHelp
altHelp) = T ctx elem altHelp -> TokenNum -> ([Char], Maybe altHelp)
forall ctx elem altHelp.
RunnerParser ctx elem altHelp
-> TokenNum -> ([Char], Maybe altHelp)
Parser.parserAltHelp T ctx elem altHelp
parser TokenNum
alt
            ]
    Maybe (FailedReason altHelp)
-> RunT ctx posMark elem altHelp m RunningResult
forall ctx posMark elem altHelp (m :: * -> *).
T posMark elem m =>
Maybe (FailedReason altHelp)
-> RunT ctx posMark elem altHelp m RunningResult
parseFail do FailedReason altHelp -> Maybe (FailedReason altHelp)
forall a. a -> Maybe a
Just do [([Char], Maybe altHelp, Maybe TokenNum)] -> FailedReason altHelp
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 :: 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 ->
                () -> RunT ctx posMark elem altHelp m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Just FailedReason altHelp
failedReason -> do
                FailedReason altHelp -> RunT ctx posMark elem altHelp m ()
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 Maybe ctx
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 = RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx))
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx))
popItem RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx))
-> (Maybe (Item posMark ctx)
    -> RunT ctx posMark elem altHelp m RunningResult)
-> RunT ctx posMark elem altHelp m RunningResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Item posMark ctx)
Nothing ->
            RunningResult -> RunT ctx posMark elem altHelp m RunningResult
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
                Maybe ctx
-> (ctx -> RunT ctx posMark elem altHelp m ())
-> RunT ctx posMark elem altHelp m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ctx
mrollbackCustomCtx0 \ctx
customCtx -> ctx -> RunT ctx posMark elem altHelp m ()
forall (m :: * -> *) ctx posMark elem altHelp.
Monad m =>
ctx -> RunT ctx posMark elem altHelp m ()
updateCustomContext ctx
customCtx
                TokenNum -> RunT ctx posMark elem altHelp m ()
forall (m :: * -> *) ctx posMark elem altHelp.
Monad m =>
TokenNum -> RunT ctx posMark elem altHelp m ()
setNextState TokenNum
backSn
                Position -> posMark -> RunT ctx posMark elem altHelp m ()
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
Position -> posMark -> RunT ctx posMark elem altHelp m ()
seekToMark Position
pos posMark
p
                RunningResult -> RunT ctx posMark elem altHelp m RunningResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunningResult
ContParse
            ItemHandleNot TokenNum
alt -> do
                Maybe ctx
-> (ctx -> RunT ctx posMark elem altHelp m ())
-> RunT ctx posMark elem altHelp m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ctx
mrollbackCustomCtx0 \ctx
customCtx -> ctx -> RunT ctx posMark elem altHelp m ()
forall (m :: * -> *) ctx posMark elem altHelp.
Monad m =>
ctx -> RunT ctx posMark elem altHelp m ()
updateCustomContext ctx
customCtx
                Context ctx posMark elem altHelp
capturedCtxForFail <- RunT ctx posMark elem altHelp m (Context ctx posMark elem altHelp)
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 Maybe ctx
forall a. Maybe a
Nothing TokenNum
alt
            ItemModifyCustomContext ctx
customCtx ->
                Maybe ctx -> RunT ctx posMark elem altHelp m RunningResult
go do ctx -> Maybe ctx
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
                TokenNum -> Position -> RunT ctx posMark elem altHelp m ()
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 = RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx))
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx))
popItem RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx))
-> (Maybe (Item posMark ctx)
    -> RunT ctx posMark elem altHelp m RunningResult)
-> RunT ctx posMark elem altHelp m RunningResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Item posMark ctx)
Nothing ->
            RunningResult -> RunT ctx posMark elem altHelp m RunningResult
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{} ->
                RunningResult -> RunT ctx posMark elem altHelp m RunningResult
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 ctx -> Maybe ctx
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 <- (Context ctx posMark elem altHelp -> T ctx elem altHelp)
-> RunT ctx posMark elem altHelp m (T ctx elem altHelp)
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 -> T ctx elem altHelp
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp -> T ctx elem altHelp
ctxParser
        case T ctx elem altHelp -> TokenNum -> AltKind
forall ctx elem altHelp.
RunnerParser ctx elem altHelp -> TokenNum -> AltKind
Parser.parserAltKind T ctx elem altHelp
parser TokenNum
alt of
            AltKind
PEG.AltSeq ->
                [Char] -> RunT ctx posMark elem altHelp m RunningResult
forall a. HasCallStack => [Char] -> a
error [Char]
"unreachable: a not handling with seq alternative"
            AltKind
PEG.AltAnd ->
                [Char] -> RunT ctx posMark elem altHelp m RunningResult
forall a. HasCallStack => [Char] -> a
error [Char]
"unreachable: a not handling with and alternative"
            AltKind
PEG.AltNot -> TokenNum
-> Position
-> Maybe ctx
-> TokenNum
-> [ReduceArgument]
-> RunT ctx posMark elem altHelp m Bool
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 [] RunT ctx posMark elem altHelp m Bool
-> (Bool -> RunT ctx posMark elem altHelp m RunningResult)
-> RunT ctx posMark elem altHelp m RunningResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Bool
False -> do
                    Context ctx posMark elem altHelp
-> RunT ctx posMark elem altHelp m ()
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
                    TokenNum -> RunT ctx posMark elem altHelp m RunningResult
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 ->
                                [Char] -> posMark
forall a. HasCallStack => [Char] -> a
error [Char]
"unreachable: no mark with not alternative"
                            Just posMark
x ->
                                posMark
x
                    Position -> posMark -> RunT ctx posMark elem altHelp m ()
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
Position -> posMark -> RunT ctx posMark elem altHelp m ()
seekToMark Position
pos0 posMark
mark0
                    TokenNum -> RunT ctx posMark elem altHelp m ()
forall (m :: * -> *) ctx posMark elem altHelp.
Monad m =>
TokenNum -> RunT ctx posMark elem altHelp m ()
setNextState TokenNum
enterSn
                    RunningResult -> RunT ctx posMark elem altHelp m RunningResult
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 :: 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 =
    TokenNum
-> [ReduceArgument]
-> RunT
     ctx posMark elem altHelp m (ActionTaskResult ctx ReduceArgument)
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 RunT
  ctx posMark elem altHelp m (ActionTaskResult ctx ReduceArgument)
-> (ActionTaskResult ctx ReduceArgument
    -> RunT ctx posMark elem altHelp m Bool)
-> RunT ctx posMark elem altHelp m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        ActionTaskResult ctx ReduceArgument
Syntax.ActionTaskFail ->
            Bool -> RunT ctx posMark elem altHelp m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        Syntax.ActionTaskResult ReduceArgument
res -> do
            TokenNum
-> Position
-> Maybe ctx
-> Maybe ctx
-> ReduceArgument
-> RunT ctx posMark elem altHelp m ()
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
forall a. Maybe a
Nothing ReduceArgument
res
            Bool -> RunT ctx posMark elem altHelp m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        Syntax.ActionTaskModifyResult ctx
ctx1 ReduceArgument
res -> do
            TokenNum
-> Position
-> Maybe ctx
-> Maybe ctx
-> ReduceArgument
-> RunT ctx posMark elem altHelp m ()
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 (ctx -> Maybe ctx
forall a. a -> Maybe a
Just ctx
ctx1) ReduceArgument
res
            Bool -> RunT ctx posMark elem altHelp m Bool
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 :: TokenNum
-> [ReduceArgument]
-> RunT
     ctx posMark elem altHelp m (ActionTaskResult ctx ReduceArgument)
runAction TokenNum
alt [ReduceArgument]
args = do
    T ctx elem altHelp
parser <- (Context ctx posMark elem altHelp -> T ctx elem altHelp)
-> RunT ctx posMark elem altHelp m (T ctx elem altHelp)
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 -> T ctx elem altHelp
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp -> T ctx elem altHelp
ctxParser
    ctx
ctx0 <- (Context ctx posMark elem altHelp -> ctx)
-> RunT ctx posMark elem altHelp m ctx
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 -> ctx
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp -> ctx
ctxCustomContext
    let actionTask :: ActionTask ctx ReduceArgument
actionTask = ActionM ctx -> [ReduceArgument] -> ActionTask ctx ReduceArgument
forall ctx.
ActionM ctx -> [ReduceArgument] -> ActionTask ctx ReduceArgument
Parser.runActionM
            do T ctx elem altHelp -> TokenNum -> ActionM ctx
forall ctx elem altHelp.
RunnerParser ctx elem altHelp -> TokenNum -> ActionM ctx
Parser.parserAction T ctx elem altHelp
parser TokenNum
alt
            do [ReduceArgument]
args
    ActionTaskResult ctx ReduceArgument
-> RunT
     ctx posMark elem altHelp m (ActionTaskResult ctx ReduceArgument)
forall (f :: * -> *) a. Applicative f => a -> f a
pure do ActionTask ctx ReduceArgument
-> ctx -> ActionTaskResult ctx ReduceArgument
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 :: 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
    Maybe ctx
-> (ctx -> RunT ctx posMark elem altHelp m ())
-> RunT ctx posMark elem altHelp m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ctx
mrollbackCustomCtx \ctx
customCtx -> do
        Bool
needBack <- RunT ctx posMark elem altHelp m Bool
forall (m :: * -> *) ctx posMark elem altHelp.
Monad m =>
RunT ctx posMark elem altHelp m Bool
isNeedBack
        Bool
-> RunT ctx posMark elem altHelp m ()
-> RunT ctx posMark elem altHelp m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needBack do
            Item posMark ctx -> RunT ctx posMark elem altHelp m ()
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
Item posMark ctx -> RunT ctx posMark elem altHelp m ()
pushItem do ctx -> Item posMark ctx
forall posMark ctx. ctx -> Item posMark ctx
ItemModifyCustomContext ctx
customCtx
    case Maybe ctx
mactionCustomCtx of
        Just ctx
customCtx ->
            ctx -> RunT ctx posMark elem altHelp m ()
forall (m :: * -> *) ctx posMark elem altHelp.
Monad m =>
ctx -> RunT ctx posMark elem altHelp m ()
updateCustomContext ctx
customCtx
        Maybe ctx
Nothing -> TokenNum
-> Position
-> RunT ctx posMark elem altHelp m (MemoItem posMark)
-> RunT ctx posMark elem altHelp m ()
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) <- RunT ctx posMark elem altHelp m (Position, posMark)
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
RunT ctx posMark elem altHelp m (Position, posMark)
getCurrentPosition
            MemoItem posMark
-> RunT ctx posMark elem altHelp m (MemoItem posMark)
forall (f :: * -> *) a. Applicative f => a -> f a
pure do Position -> posMark -> ReduceArgument -> MemoItem posMark
forall posMark.
Position -> posMark -> ReduceArgument -> MemoItem posMark
MemoItemParsed Position
pos1 posMark
pm1 ReduceArgument
res
    Item posMark ctx -> RunT ctx posMark elem altHelp m ()
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
Item posMark ctx -> RunT ctx posMark elem altHelp m ()
pushItem do ReduceArgument -> Item posMark ctx
forall posMark ctx. ReduceArgument -> Item posMark ctx
ItemArgument ReduceArgument
res

saveFailedEnterAction
    :: Monad m
    => Parser.VarNum -> Position -> RunT ctx posMark elem altHelp m ()
saveFailedEnterAction :: TokenNum -> Position -> RunT ctx posMark elem altHelp m ()
saveFailedEnterAction TokenNum
v Position
pos = TokenNum
-> Position
-> RunT ctx posMark elem altHelp m (MemoItem posMark)
-> RunT ctx posMark elem altHelp m ()
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
    MemoItem posMark
-> RunT ctx posMark elem altHelp m (MemoItem posMark)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MemoItem posMark
forall posMark. MemoItem posMark
MemoItemFailed

reportError
    :: Scanner.T posMark elem m
    => FailedReason altHelp -> RunT ctx posMark elem altHelp m ()
reportError :: FailedReason altHelp -> RunT ctx posMark elem altHelp m ()
reportError FailedReason altHelp
failedReason = do
    (Position
pos0, posMark
posMark0) <- RunT ctx posMark elem altHelp m (Position, posMark)
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
RunT ctx posMark elem altHelp m (Position, posMark)
getCurrentPosition
    StateT (Context ctx posMark elem altHelp) m ()
-> RunT ctx posMark elem altHelp m ()
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
 -> Context ctx posMark elem altHelp)
-> StateT (Context ctx posMark elem altHelp) m ()
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 Context ctx posMark elem altHelp
-> Maybe (Position, posMark, FailedReason altHelp)
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 Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< Position
pos1 ->
                    Maybe (Position, posMark, FailedReason altHelp)
oldErr
                Maybe (Position, posMark, FailedReason altHelp)
_ ->
                    (Position, posMark, FailedReason altHelp)
-> 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 :: 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 <- RunT ctx posMark elem altHelp m Bool
forall (m :: * -> *) ctx posMark elem altHelp.
Monad m =>
RunT ctx posMark elem altHelp m Bool
isNeedBack
    Bool
-> RunT ctx posMark elem altHelp m ()
-> RunT ctx posMark elem altHelp m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needBack do
        MemoItem posMark
memoItem <- RunT ctx posMark elem altHelp m (MemoItem posMark)
mitem
        StateT (Context ctx posMark elem altHelp) m ()
-> RunT ctx posMark elem altHelp m ()
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
 -> Context ctx posMark elem altHelp)
-> StateT (Context ctx posMark elem altHelp) m ()
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 = Position
-> IntMap (MemoItem posMark)
-> T Position (IntMap (MemoItem posMark))
-> T Position (IntMap (MemoItem posMark))
forall n a. T n => n -> a -> Map n a -> Map n a
AlignableMap.insert Position
pos
                    do case Position
-> T Position (IntMap (MemoItem posMark))
-> Maybe (IntMap (MemoItem posMark))
forall n a. T n => n -> Map n a -> Maybe a
AlignableMap.lookup Position
pos do Context ctx posMark elem altHelp
-> T Position (IntMap (MemoItem posMark))
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 -> TokenNum -> MemoItem posMark -> IntMap (MemoItem posMark)
forall a. TokenNum -> a -> IntMap a
IntMap.singleton TokenNum
v MemoItem posMark
memoItem
                        Just IntMap (MemoItem posMark)
vm -> TokenNum
-> MemoItem posMark
-> IntMap (MemoItem posMark)
-> IntMap (MemoItem posMark)
forall a. TokenNum -> a -> IntMap a -> IntMap a
IntMap.insert TokenNum
v MemoItem posMark
memoItem IntMap (MemoItem posMark)
vm
                    do Context ctx posMark elem altHelp
-> T Position (IntMap (MemoItem posMark))
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 :: ctx -> RunT ctx posMark elem altHelp m ()
updateCustomContext ctx
customCtx = StateT (Context ctx posMark elem altHelp) m ()
-> RunT ctx posMark elem altHelp m ()
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
 -> Context ctx posMark elem altHelp)
-> StateT (Context ctx posMark elem altHelp) m ()
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 = T Position (IntMap (MemoItem posMark))
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 :: TokenNum -> RunT ctx posMark elem altHelp m ()
setNextState TokenNum
sn = StateT (Context ctx posMark elem altHelp) m ()
-> RunT ctx posMark elem altHelp m ()
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
 -> Context ctx posMark elem altHelp)
-> StateT (Context ctx posMark elem altHelp) m ()
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 :: (Context ctx posMark elem altHelp -> a)
-> RunT ctx posMark elem altHelp m a
getCtx Context ctx posMark elem altHelp -> a
f = StateT (Context ctx posMark elem altHelp) m a
-> RunT ctx posMark elem altHelp m a
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 (Context ctx posMark elem altHelp -> a)
-> StateT
     (Context ctx posMark elem altHelp)
     m
     (Context ctx posMark elem altHelp)
-> StateT (Context ctx posMark elem altHelp) m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
  (Context ctx posMark elem altHelp)
  m
  (Context ctx posMark elem altHelp)
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 :: RunT ctx posMark elem altHelp m (Context ctx posMark elem altHelp)
captureCtx = StateT
  (Context ctx posMark elem altHelp)
  m
  (Context ctx posMark elem altHelp)
-> RunT
     ctx posMark elem altHelp m (Context ctx posMark elem altHelp)
forall ctx posMark elem altHelp (m :: * -> *) a.
StateT (Context ctx posMark elem altHelp) m a
-> RunT ctx posMark elem altHelp m a
RunT StateT
  (Context ctx posMark elem altHelp)
  m
  (Context ctx posMark elem altHelp)
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 :: Context ctx posMark elem altHelp
-> RunT ctx posMark elem altHelp m ()
restoreCtx Context ctx posMark elem altHelp
ctx = StateT (Context ctx posMark elem altHelp) m ()
-> RunT ctx posMark elem altHelp m ()
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
-> StateT (Context ctx posMark elem altHelp) m ()
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 :: RunT ctx posMark elem altHelp m (Position, posMark)
getCurrentPosition = (Context ctx posMark elem altHelp
 -> Maybe (Position, posMark, TokenNum, Maybe elem))
-> RunT
     ctx
     posMark
     elem
     altHelp
     m
     (Maybe (Position, posMark, TokenNum, Maybe elem))
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
-> Maybe (Position, posMark, TokenNum, Maybe elem)
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp
-> Maybe (Position, posMark, TokenNum, Maybe elem)
ctxLookAHeadToken RunT
  ctx
  posMark
  elem
  altHelp
  m
  (Maybe (Position, posMark, TokenNum, Maybe elem))
-> (Maybe (Position, posMark, TokenNum, Maybe elem)
    -> RunT ctx posMark elem altHelp m (Position, posMark))
-> RunT ctx posMark elem altHelp m (Position, posMark)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (Position
pos, posMark
pm, TokenNum
_, Maybe elem
_) ->
        (Position, posMark)
-> RunT ctx posMark elem altHelp m (Position, posMark)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Position
pos, posMark
pm)
    Maybe (Position, posMark, TokenNum, Maybe elem)
Nothing -> do
        posMark
pm <- m posMark -> RunT ctx posMark elem altHelp m posMark
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m posMark
forall posMark elem (m :: * -> *).
Scanner posMark elem m =>
m posMark
Scanner.getPosMark
        Position
pos <- (Context ctx posMark elem altHelp -> Position)
-> RunT ctx posMark elem altHelp m Position
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 -> Position
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp -> Position
ctxNextPosition
        (Position, posMark)
-> RunT ctx posMark elem altHelp m (Position, posMark)
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 :: RunT ctx posMark elem altHelp m (TokenNum, Maybe elem)
consumeIfNeeded = (Context ctx posMark elem altHelp
 -> Maybe (Position, posMark, TokenNum, Maybe elem))
-> RunT
     ctx
     posMark
     elem
     altHelp
     m
     (Maybe (Position, posMark, TokenNum, Maybe elem))
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
-> Maybe (Position, posMark, TokenNum, Maybe elem)
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp
-> Maybe (Position, posMark, TokenNum, Maybe elem)
ctxLookAHeadToken RunT
  ctx
  posMark
  elem
  altHelp
  m
  (Maybe (Position, posMark, TokenNum, Maybe elem))
-> (Maybe (Position, posMark, TokenNum, Maybe elem)
    -> RunT ctx posMark elem altHelp m (TokenNum, Maybe elem))
-> RunT ctx posMark elem altHelp m (TokenNum, Maybe elem)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (Position
_, posMark
_, TokenNum
tn, Maybe elem
mt) ->
        (TokenNum, Maybe elem)
-> RunT ctx posMark elem altHelp m (TokenNum, Maybe elem)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TokenNum
tn, Maybe elem
mt)
    Maybe (Position, posMark, TokenNum, Maybe elem)
Nothing -> do
        posMark
pm <- m posMark -> RunT ctx posMark elem altHelp m posMark
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m posMark
forall posMark elem (m :: * -> *).
Scanner posMark elem m =>
m posMark
Scanner.getPosMark
        r :: (TokenNum, Maybe elem)
r@(TokenNum
tn, Maybe elem
mt) <- m (Maybe elem) -> RunT ctx posMark elem altHelp m (Maybe elem)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe elem)
forall posMark elem (m :: * -> *).
Scanner posMark elem m =>
m (Maybe elem)
Scanner.consumeInput RunT ctx posMark elem altHelp m (Maybe elem)
-> (Maybe elem
    -> RunT ctx posMark elem altHelp m (TokenNum, Maybe elem))
-> RunT ctx posMark elem altHelp m (TokenNum, Maybe elem)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe elem
Nothing ->
                (TokenNum, Maybe elem)
-> RunT ctx posMark elem altHelp m (TokenNum, Maybe elem)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TokenNum
Parser.eosToken, Maybe elem
forall a. Maybe a
Nothing)
            Just elem
t -> do
                T ctx elem altHelp
parser <- (Context ctx posMark elem altHelp -> T ctx elem altHelp)
-> RunT ctx posMark elem altHelp m (T ctx elem altHelp)
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 -> T ctx elem altHelp
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp -> T ctx elem altHelp
ctxParser
                let tn :: TokenNum
tn = T ctx elem altHelp -> elem -> TokenNum
forall ctx elem altHelp.
RunnerParser ctx elem altHelp -> elem -> TokenNum
Parser.parserGetTokenNum T ctx elem altHelp
parser elem
t
                (TokenNum, Maybe elem)
-> RunT ctx posMark elem altHelp m (TokenNum, Maybe elem)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TokenNum
tn, elem -> Maybe elem
forall a. a -> Maybe a
Just elem
t)
        StateT (Context ctx posMark elem altHelp) m ()
-> RunT ctx posMark elem altHelp m ()
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
 -> Context ctx posMark elem altHelp)
-> StateT (Context ctx posMark elem altHelp) m ()
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 = Position -> Position
forall i. Alignable i => i -> i
Alignable.nextAlign
                    do Context ctx posMark elem altHelp -> Position
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 = (Position, posMark, TokenNum, Maybe elem)
-> Maybe (Position, posMark, TokenNum, Maybe elem)
forall a. a -> Maybe a
Just
                    (Context ctx posMark elem altHelp -> Position
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)
                }
        (TokenNum, Maybe elem)
-> RunT ctx posMark elem altHelp m (TokenNum, Maybe elem)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TokenNum, Maybe elem)
r

shift :: Monad m => RunT ctx posMark elem altHelp m ()
shift :: RunT ctx posMark elem altHelp m ()
shift = (Context ctx posMark elem altHelp
 -> Maybe (Position, posMark, TokenNum, Maybe elem))
-> RunT
     ctx
     posMark
     elem
     altHelp
     m
     (Maybe (Position, posMark, TokenNum, Maybe elem))
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
-> Maybe (Position, posMark, TokenNum, Maybe elem)
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp
-> Maybe (Position, posMark, TokenNum, Maybe elem)
ctxLookAHeadToken RunT
  ctx
  posMark
  elem
  altHelp
  m
  (Maybe (Position, posMark, TokenNum, Maybe elem))
-> (Maybe (Position, posMark, TokenNum, Maybe elem)
    -> RunT ctx posMark elem altHelp m ())
-> RunT ctx posMark elem altHelp m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Position, posMark, TokenNum, Maybe elem)
Nothing ->
        [Char] -> RunT ctx posMark elem altHelp m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Must consume before shift"
    Just (Position
_, posMark
_, TokenNum
_, Maybe elem
Nothing) ->
        [Char] -> RunT ctx posMark elem altHelp m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"No more shift"
    Just (Position
_, posMark
_, TokenNum
_, Just{}) ->
        StateT (Context ctx posMark elem altHelp) m ()
-> RunT ctx posMark elem altHelp m ()
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
 -> Context ctx posMark elem altHelp)
-> StateT (Context ctx posMark elem altHelp) m ()
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 = Maybe (Position, posMark, TokenNum, Maybe elem)
forall a. Maybe a
Nothing
                }

seekToMark :: Scanner.T posMark elem m
    => Position -> posMark -> RunT ctx posMark elem altHelp m ()
seekToMark :: Position -> posMark -> RunT ctx posMark elem altHelp m ()
seekToMark Position
pos posMark
pm = do
    StateT (Context ctx posMark elem altHelp) m ()
-> RunT ctx posMark elem altHelp m ()
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
 -> Context ctx posMark elem altHelp)
-> StateT (Context ctx posMark elem altHelp) m ()
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 = Maybe (Position, posMark, TokenNum, Maybe elem)
forall a. Maybe a
Nothing
            , $sel:ctxNextPosition:Context :: Position
ctxNextPosition = Position
pos
            }
    m () -> RunT ctx posMark elem altHelp m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do posMark -> m ()
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 :: RunT ctx posMark elem altHelp m Bool
isNeedBack = do
    TokenNum
needBackItemsCount <- (Context ctx posMark elem altHelp -> TokenNum)
-> RunT ctx posMark elem altHelp m TokenNum
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 -> TokenNum
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp -> TokenNum
ctxNeedBackItemsCount
    Bool -> RunT ctx posMark elem altHelp m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure do TokenNum
needBackItemsCount TokenNum -> TokenNum -> Bool
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 :: Item posMark ctx -> RunT ctx posMark elem altHelp m ()
pushItem Item posMark ctx
item = do
    (Position
pos, posMark
p) <- RunT ctx posMark elem altHelp m (Position, posMark)
forall posMark elem (m :: * -> *) ctx altHelp.
T posMark elem m =>
RunT ctx posMark elem altHelp m (Position, posMark)
getCurrentPosition
    TokenNum
bc0 <- (Context ctx posMark elem altHelp -> TokenNum)
-> RunT ctx posMark elem altHelp m TokenNum
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 -> TokenNum
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp -> TokenNum
ctxNeedBackItemsCount
    let bc1 :: TokenNum
bc1 = if Item posMark ctx -> Bool
forall posMark ctx. Item posMark ctx -> Bool
isNeedBackItem Item posMark ctx
item then TokenNum
bc0 TokenNum -> TokenNum -> TokenNum
forall a. Num a => a -> a -> a
+ TokenNum
1 else TokenNum
bc0
    Bool
-> RunT ctx posMark elem altHelp m ()
-> RunT ctx posMark elem altHelp m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when do TokenNum
bc0 TokenNum -> TokenNum -> Bool
forall a. Eq a => a -> a -> Bool
== TokenNum
0 Bool -> Bool -> Bool
&& TokenNum
bc1 TokenNum -> TokenNum -> Bool
forall a. Ord a => a -> a -> Bool
> TokenNum
0
        do m () -> RunT ctx posMark elem altHelp m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do ScanMode posMark -> m ()
forall posMark elem (m :: * -> *).
Scanner posMark elem m =>
ScanMode posMark -> m ()
Scanner.scanMode do posMark -> ScanMode posMark
forall posMark. posMark -> ScanMode posMark
Scanner.ScanModeNeedBack posMark
p
    StateT (Context ctx posMark elem altHelp) m ()
-> RunT ctx posMark elem altHelp m ()
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
 -> Context ctx posMark elem altHelp)
-> StateT (Context ctx posMark elem altHelp) m ()
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
itemItem posMark ctx -> [Item posMark ctx] -> [Item posMark ctx]
forall a. a -> [a] -> [a]
:Context ctx posMark elem altHelp -> [Item posMark ctx]
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 TokenNum -> TokenNum -> Bool
forall a. Eq a => a -> a -> Bool
== TokenNum
0 Bool -> Bool -> Bool
&& TokenNum
bc1 TokenNum -> TokenNum -> Bool
forall a. Ord a => a -> a -> Bool
> TokenNum
0
                then do
                    Position
-> T Position (IntMap (MemoItem posMark))
-> T Position (IntMap (MemoItem posMark))
forall n a. T n => n -> Map n a -> Map n a
AlignableMap.restrictGreaterOrEqual
                        do Position
pos
                        do Context ctx posMark elem altHelp
-> T Position (IntMap (MemoItem posMark))
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp
-> T Position (IntMap (MemoItem posMark))
ctxMemoTable Context ctx posMark elem altHelp
ctx
                else
                    Context ctx posMark elem altHelp
-> T Position (IntMap (MemoItem posMark))
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 :: RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx))
popItem = (Context ctx posMark elem altHelp -> [Item posMark ctx])
-> RunT ctx posMark elem altHelp m [Item posMark ctx]
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 -> [Item posMark ctx]
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp -> [Item posMark ctx]
ctxItemStack RunT ctx posMark elem altHelp m [Item posMark ctx]
-> ([Item posMark ctx]
    -> RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx)))
-> RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    [] ->
        Maybe (Item posMark ctx)
-> RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Item posMark ctx)
forall a. Maybe a
Nothing
    Item posMark ctx
item:[Item posMark ctx]
rest -> do
        TokenNum
bc0 <- (Context ctx posMark elem altHelp -> TokenNum)
-> RunT ctx posMark elem altHelp m TokenNum
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 -> TokenNum
forall ctx posMark elem altHelp.
Context ctx posMark elem altHelp -> TokenNum
ctxNeedBackItemsCount
        let bc1 :: TokenNum
bc1 = if Item posMark ctx -> Bool
forall posMark ctx. Item posMark ctx -> Bool
isNeedBackItem Item posMark ctx
item then TokenNum
bc0 TokenNum -> TokenNum -> TokenNum
forall a. Num a => a -> a -> a
- TokenNum
1 else TokenNum
bc0
        Bool
-> RunT ctx posMark elem altHelp m ()
-> RunT ctx posMark elem altHelp m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when do TokenNum
bc1 TokenNum -> TokenNum -> Bool
forall a. Eq a => a -> a -> Bool
== TokenNum
0
            do m () -> RunT ctx posMark elem altHelp m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do ScanMode posMark -> m ()
forall posMark elem (m :: * -> *).
Scanner posMark elem m =>
ScanMode posMark -> m ()
Scanner.scanMode ScanMode posMark
forall posMark. ScanMode posMark
Scanner.ScanModeNoBack
        StateT (Context ctx posMark elem altHelp) m ()
-> RunT ctx posMark elem altHelp m ()
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
 -> Context ctx posMark elem altHelp)
-> StateT (Context ctx posMark elem altHelp) m ()
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
                }
        Maybe (Item posMark ctx)
-> RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure do Item posMark ctx -> Maybe (Item posMark ctx)
forall a. a -> Maybe a
Just Item posMark ctx
item

isNeedBackItem :: Item posMark ctx -> Bool
isNeedBackItem :: 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