module Language.Lexer.Tlex.Runner (
    TlexContext (..),
    TlexResult (..),
    Runner (..),
    runRunner,
) where

import           Language.Lexer.Tlex.Prelude


class (Enum e, Monad m) => TlexContext p e m | m -> p, m -> e where
    tlexGetInputPart :: m (Maybe e)
    tlexGetMark :: m p

data TlexResult p a
    = TlexEndOfInput
    | TlexError
    | TlexAccepted p a
    deriving (TlexResult p a -> TlexResult p a -> Bool
(TlexResult p a -> TlexResult p a -> Bool)
-> (TlexResult p a -> TlexResult p a -> Bool)
-> Eq (TlexResult p a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall p a.
(Eq p, Eq a) =>
TlexResult p a -> TlexResult p a -> Bool
/= :: TlexResult p a -> TlexResult p a -> Bool
$c/= :: forall p a.
(Eq p, Eq a) =>
TlexResult p a -> TlexResult p a -> Bool
== :: TlexResult p a -> TlexResult p a -> Bool
$c== :: forall p a.
(Eq p, Eq a) =>
TlexResult p a -> TlexResult p a -> Bool
Eq, Int -> TlexResult p a -> ShowS
[TlexResult p a] -> ShowS
TlexResult p a -> String
(Int -> TlexResult p a -> ShowS)
-> (TlexResult p a -> String)
-> ([TlexResult p a] -> ShowS)
-> Show (TlexResult p a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p a. (Show p, Show a) => Int -> TlexResult p a -> ShowS
forall p a. (Show p, Show a) => [TlexResult p a] -> ShowS
forall p a. (Show p, Show a) => TlexResult p a -> String
showList :: [TlexResult p a] -> ShowS
$cshowList :: forall p a. (Show p, Show a) => [TlexResult p a] -> ShowS
show :: TlexResult p a -> String
$cshow :: forall p a. (Show p, Show a) => TlexResult p a -> String
showsPrec :: Int -> TlexResult p a -> ShowS
$cshowsPrec :: forall p a. (Show p, Show a) => Int -> TlexResult p a -> ShowS
Show)


data Runner e a = Runner
    { Runner e a -> Int -> Int
tlexInitial :: Int -> Int
    -- ^ StartState -> (StateNum | -1)
    , Runner e a -> Int -> Maybe a
tlexAccept  :: Int -> Maybe a
    -- ^ StateNum -> Maybe Action
    , Runner e a -> Int -> Int -> Int
tlexTrans   :: Int -> Int -> Int
    -- ^ StateNum -> CodeUnit -> (StateNum | -1)
    }
    deriving a -> Runner e b -> Runner e a
(a -> b) -> Runner e a -> Runner e b
(forall a b. (a -> b) -> Runner e a -> Runner e b)
-> (forall a b. a -> Runner e b -> Runner e a)
-> Functor (Runner e)
forall k (e :: k) a b. a -> Runner e b -> Runner e a
forall k (e :: k) a b. (a -> b) -> Runner e a -> Runner e b
forall a b. a -> Runner e b -> Runner e a
forall a b. (a -> b) -> Runner e a -> Runner e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Runner e b -> Runner e a
$c<$ :: forall k (e :: k) a b. a -> Runner e b -> Runner e a
fmap :: (a -> b) -> Runner e a -> Runner e b
$cfmap :: forall k (e :: k) a b. (a -> b) -> Runner e a -> Runner e b
Functor

runRunner :: Enum s => TlexContext p c m => Runner c a -> s -> m (TlexResult p a)
runRunner :: Runner c a -> s -> m (TlexResult p a)
runRunner Runner c a
runner s
s0 = case Runner c a -> Int -> Int
forall k (e :: k) a. Runner e a -> Int -> Int
tlexInitial Runner c a
runner do s -> Int
forall a. Enum a => a -> Int
fromEnum s
s0 of
        Int
-1 -> String -> m (TlexResult p a)
forall a. HasCallStack => String -> a
error String
"unknown initial state"
        Int
s  -> Int -> m (TlexResult p a)
go Int
s
    where
        go :: Int -> m (TlexResult p a)
go Int
s = case Runner c a -> Int -> Maybe a
forall k (e :: k) a. Runner e a -> Int -> Maybe a
tlexAccept Runner c a
runner Int
s of
            Just a
x  -> do
                TlexResult p a
acc <- a -> m (TlexResult p a)
forall (m :: * -> *) p e a.
TlexContext p e m =>
a -> m (TlexResult p a)
buildAccepted a
x
                Maybe c
mc <- m (Maybe c)
forall p e (m :: * -> *). TlexContext p e m => m (Maybe e)
tlexGetInputPart
                case Maybe c
mc of
                    Maybe c
Nothing -> TlexResult p a -> m (TlexResult p a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TlexResult p a
acc
                    Just c
c  -> Int -> c -> Maybe (TlexResult p a) -> m (TlexResult p a)
goTrans Int
s c
c do TlexResult p a -> Maybe (TlexResult p a)
forall a. a -> Maybe a
Just TlexResult p a
acc
            Maybe a
Nothing -> do
                Maybe c
mc <- m (Maybe c)
forall p e (m :: * -> *). TlexContext p e m => m (Maybe e)
tlexGetInputPart
                case Maybe c
mc of
                    Maybe c
Nothing -> TlexResult p a -> m (TlexResult p a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TlexResult p a
forall p a. TlexResult p a
TlexEndOfInput
                    Just c
c  -> Int -> c -> Maybe (TlexResult p a) -> m (TlexResult p a)
goTrans Int
s c
c Maybe (TlexResult p a)
forall a. Maybe a
Nothing

        goTrans :: Int -> c -> Maybe (TlexResult p a) -> m (TlexResult p a)
goTrans Int
s c
c Maybe (TlexResult p a)
preAccepted = case Runner c a -> Int -> Int -> Int
forall k (e :: k) a. Runner e a -> Int -> Int -> Int
tlexTrans Runner c a
runner Int
s do c -> Int
forall a. Enum a => a -> Int
fromEnum c
c of
            Int
-1 -> Maybe (TlexResult p a) -> m (TlexResult p a)
forall (f :: * -> *) p a.
Applicative f =>
Maybe (TlexResult p a) -> f (TlexResult p a)
goEnd Maybe (TlexResult p a)
preAccepted
            Int
ns -> do
                Maybe (TlexResult p a)
nacc <- case Runner c a -> Int -> Maybe a
forall k (e :: k) a. Runner e a -> Int -> Maybe a
tlexAccept Runner c a
runner Int
ns of
                    Just a
x -> do
                        TlexResult p a
acc <- a -> m (TlexResult p a)
forall (m :: * -> *) p e a.
TlexContext p e m =>
a -> m (TlexResult p a)
buildAccepted a
x
                        Maybe (TlexResult p a) -> m (Maybe (TlexResult p a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure do TlexResult p a -> Maybe (TlexResult p a)
forall a. a -> Maybe a
Just TlexResult p a
acc
                    Maybe a
Nothing -> Maybe (TlexResult p a) -> m (Maybe (TlexResult p a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TlexResult p a)
preAccepted
                Maybe c
mc <- m (Maybe c)
forall p e (m :: * -> *). TlexContext p e m => m (Maybe e)
tlexGetInputPart
                case Maybe c
mc of
                    Maybe c
Nothing -> Maybe (TlexResult p a) -> m (TlexResult p a)
forall (f :: * -> *) p a.
Applicative f =>
Maybe (TlexResult p a) -> f (TlexResult p a)
goEnd Maybe (TlexResult p a)
nacc
                    Just c
nc -> Int -> c -> Maybe (TlexResult p a) -> m (TlexResult p a)
goTrans Int
ns c
nc Maybe (TlexResult p a)
nacc

        buildAccepted :: a -> m (TlexResult p a)
buildAccepted a
x = do
            p
m <- m p
forall p e (m :: * -> *). TlexContext p e m => m p
tlexGetMark
            TlexResult p a -> m (TlexResult p a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure do p -> a -> TlexResult p a
forall p a. p -> a -> TlexResult p a
TlexAccepted p
m a
x

        goEnd :: Maybe (TlexResult p a) -> f (TlexResult p a)
goEnd Maybe (TlexResult p a)
preAccepted = case Maybe (TlexResult p a)
preAccepted of
            Maybe (TlexResult p a)
Nothing  -> TlexResult p a -> f (TlexResult p a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TlexResult p a
forall p a. TlexResult p a
TlexError
            Just TlexResult p a
acc -> TlexResult p a -> f (TlexResult p a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TlexResult p a
acc