module Language.Lexer.Tlex.Machine.DFA (
    DFA (..),
    DFAState (..),
    DFABuilder,
    DFABuilderContext,
    buildDFA,
    newStateNum,
    insertTrans,
    accept,
    initial,
) where

import           Language.Lexer.Tlex.Prelude

import qualified Data.EnumMap.Strict                 as EnumMap
import qualified Data.IntMap                         as IntMap
import qualified Data.List                           as List
import qualified Language.Lexer.Tlex.Machine.Pattern as Pattern
import qualified Language.Lexer.Tlex.Machine.State   as MState


data DFA a = DFA
    { forall a. DFA a -> EnumMap StartState StateNum
dfaInitials :: EnumMap.EnumMap Pattern.StartState MState.StateNum
    , forall a. DFA a -> StateArray (DFAState a)
dfaTrans    :: MState.StateArray (DFAState a)
    }
    deriving (DFA a -> DFA a -> Bool
forall a. Eq a => DFA a -> DFA a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DFA a -> DFA a -> Bool
$c/= :: forall a. Eq a => DFA a -> DFA a -> Bool
== :: DFA a -> DFA a -> Bool
$c== :: forall a. Eq a => DFA a -> DFA a -> Bool
Eq, Int -> DFA a -> ShowS
forall a. Show a => Int -> DFA a -> ShowS
forall a. Show a => [DFA a] -> ShowS
forall a. Show a => DFA a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DFA a] -> ShowS
$cshowList :: forall a. Show a => [DFA a] -> ShowS
show :: DFA a -> String
$cshow :: forall a. Show a => DFA a -> String
showsPrec :: Int -> DFA a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> DFA a -> ShowS
Show, forall a b. a -> DFA b -> DFA a
forall a b. (a -> b) -> DFA a -> DFA b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> DFA b -> DFA a
$c<$ :: forall a b. a -> DFA b -> DFA a
fmap :: forall a b. (a -> b) -> DFA a -> DFA b
$cfmap :: forall a b. (a -> b) -> DFA a -> DFA b
Functor)

data DFAState a = DState
    { forall a. DFAState a -> [Accept a]
dstAccepts    :: [Pattern.Accept a]
    , forall a. DFAState a -> IntMap StateNum
dstTrans      :: IntMap.IntMap MState.StateNum
    , forall a. DFAState a -> Maybe StateNum
dstOtherTrans :: Maybe MState.StateNum
    }
    deriving (DFAState a -> DFAState a -> Bool
forall a. Eq a => DFAState a -> DFAState a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DFAState a -> DFAState a -> Bool
$c/= :: forall a. Eq a => DFAState a -> DFAState a -> Bool
== :: DFAState a -> DFAState a -> Bool
$c== :: forall a. Eq a => DFAState a -> DFAState a -> Bool
Eq, Int -> DFAState a -> ShowS
forall a. Show a => Int -> DFAState a -> ShowS
forall a. Show a => [DFAState a] -> ShowS
forall a. Show a => DFAState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DFAState a] -> ShowS
$cshowList :: forall a. Show a => [DFAState a] -> ShowS
show :: DFAState a -> String
$cshow :: forall a. Show a => DFAState a -> String
showsPrec :: Int -> DFAState a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> DFAState a -> ShowS
Show, forall a b. a -> DFAState b -> DFAState a
forall a b. (a -> b) -> DFAState a -> DFAState b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> DFAState b -> DFAState a
$c<$ :: forall a b. a -> DFAState b -> DFAState a
fmap :: forall a b. (a -> b) -> DFAState a -> DFAState b
$cfmap :: forall a b. (a -> b) -> DFAState a -> DFAState b
Functor)


data DFABuilderContext m = DFABuilderContext
    { forall m. DFABuilderContext m -> EnumMap StartState StateNum
dfaBCtxInitials     :: EnumMap.EnumMap Pattern.StartState MState.StateNum
    , forall m. DFABuilderContext m -> StateNum
dfaBCtxNextStateNum :: MState.StateNum
    , forall m. DFABuilderContext m -> StateMap (DFAState m)
dfaBCtxStateMap     :: MState.StateMap (DFAState m)
    }
    deriving (DFABuilderContext m -> DFABuilderContext m -> Bool
forall m.
Eq m =>
DFABuilderContext m -> DFABuilderContext m -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DFABuilderContext m -> DFABuilderContext m -> Bool
$c/= :: forall m.
Eq m =>
DFABuilderContext m -> DFABuilderContext m -> Bool
== :: DFABuilderContext m -> DFABuilderContext m -> Bool
$c== :: forall m.
Eq m =>
DFABuilderContext m -> DFABuilderContext m -> Bool
Eq, Int -> DFABuilderContext m -> ShowS
forall m. Show m => Int -> DFABuilderContext m -> ShowS
forall m. Show m => [DFABuilderContext m] -> ShowS
forall m. Show m => DFABuilderContext m -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DFABuilderContext m] -> ShowS
$cshowList :: forall m. Show m => [DFABuilderContext m] -> ShowS
show :: DFABuilderContext m -> String
$cshow :: forall m. Show m => DFABuilderContext m -> String
showsPrec :: Int -> DFABuilderContext m -> ShowS
$cshowsPrec :: forall m. Show m => Int -> DFABuilderContext m -> ShowS
Show, forall a b. a -> DFABuilderContext b -> DFABuilderContext a
forall a b. (a -> b) -> DFABuilderContext a -> DFABuilderContext b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> DFABuilderContext b -> DFABuilderContext a
$c<$ :: forall a b. a -> DFABuilderContext b -> DFABuilderContext a
fmap :: forall a b. (a -> b) -> DFABuilderContext a -> DFABuilderContext b
$cfmap :: forall a b. (a -> b) -> DFABuilderContext a -> DFABuilderContext b
Functor)

type DFABuilder m = State (DFABuilderContext m)

buildDFA :: DFABuilder m () -> DFA m
buildDFA :: forall m. DFABuilder m () -> DFA m
buildDFA DFABuilder m ()
builder =
    let bctx :: DFABuilderContext m
bctx = forall s a. State s a -> s -> s
execState DFABuilder m ()
builder forall {m}. DFABuilderContext m
initialBCtx
        arr :: StateArray (DFAState m)
arr = forall a. StateNum -> StateMap a -> StateArray a
MState.totalStateMapToArray
            do forall m. DFABuilderContext m -> StateNum
dfaBCtxNextStateNum DFABuilderContext m
bctx
            do forall m. DFABuilderContext m -> StateMap (DFAState m)
dfaBCtxStateMap DFABuilderContext m
bctx
    in DFA
        { $sel:dfaInitials:DFA :: EnumMap StartState StateNum
dfaInitials = forall m. DFABuilderContext m -> EnumMap StartState StateNum
dfaBCtxInitials DFABuilderContext m
bctx
        , $sel:dfaTrans:DFA :: StateArray (DFAState m)
dfaTrans = StateArray (DFAState m)
arr
        }
    where
        initialBCtx :: DFABuilderContext m
initialBCtx = DFABuilderContext
            { $sel:dfaBCtxInitials:DFABuilderContext :: EnumMap StartState StateNum
dfaBCtxInitials = forall k a. EnumMap k a
EnumMap.empty
            , $sel:dfaBCtxNextStateNum:DFABuilderContext :: StateNum
dfaBCtxNextStateNum = StateNum
MState.initialStateNum
            , $sel:dfaBCtxStateMap:DFABuilderContext :: StateMap (DFAState m)
dfaBCtxStateMap = forall a. StateMap a
MState.emptyMap
            }

newStateNum :: DFABuilder m MState.StateNum
newStateNum :: forall m. DFABuilder m StateNum
newStateNum = do
    DFABuilderContext m
ctx0 <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    let nextStateNum :: StateNum
nextStateNum = forall m. DFABuilderContext m -> StateNum
dfaBCtxNextStateNum DFABuilderContext m
ctx0
    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do DFABuilderContext m
ctx0
            { $sel:dfaBCtxNextStateNum:DFABuilderContext :: StateNum
dfaBCtxNextStateNum = forall a. Enum a => a -> a
succ StateNum
nextStateNum
            }
    forall (f :: * -> *) a. Applicative f => a -> f a
pure StateNum
nextStateNum

insertTrans :: MState.StateNum -> DFAState m -> DFABuilder m ()
insertTrans :: forall m. StateNum -> DFAState m -> DFABuilder m ()
insertTrans StateNum
sf DFAState m
st = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \ctx0 :: DFABuilderContext m
ctx0@DFABuilderContext{ StateMap (DFAState m)
dfaBCtxStateMap :: StateMap (DFAState m)
$sel:dfaBCtxStateMap:DFABuilderContext :: forall m. DFABuilderContext m -> StateMap (DFAState m)
dfaBCtxStateMap } -> DFABuilderContext m
ctx0
    { $sel:dfaBCtxStateMap:DFABuilderContext :: StateMap (DFAState m)
dfaBCtxStateMap = StateMap (DFAState m) -> StateMap (DFAState m)
addCondTrans StateMap (DFAState m)
dfaBCtxStateMap
    }
    where
        addCondTrans :: StateMap (DFAState m) -> StateMap (DFAState m)
addCondTrans StateMap (DFAState m)
n = forall a. StateNum -> a -> StateMap a -> StateMap a
MState.insertMap StateNum
sf DFAState m
st StateMap (DFAState m)
n

accept :: MState.StateNum -> Pattern.Accept m -> DFABuilder m ()
accept :: forall m. StateNum -> Accept m -> DFABuilder m ()
accept StateNum
s Accept m
x = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \ctx0 :: DFABuilderContext m
ctx0@DFABuilderContext{ StateMap (DFAState m)
dfaBCtxStateMap :: StateMap (DFAState m)
$sel:dfaBCtxStateMap:DFABuilderContext :: forall m. DFABuilderContext m -> StateMap (DFAState m)
dfaBCtxStateMap } -> DFABuilderContext m
ctx0
    { $sel:dfaBCtxStateMap:DFABuilderContext :: StateMap (DFAState m)
dfaBCtxStateMap = StateMap (DFAState m) -> StateMap (DFAState m)
addAccept StateMap (DFAState m)
dfaBCtxStateMap
    }
    where
        addAccept :: StateMap (DFAState m) -> StateMap (DFAState m)
addAccept StateMap (DFAState m)
n = forall a. StateNum -> a -> (a -> a) -> StateMap a -> StateMap a
MState.insertOrUpdateMap StateNum
s
            do DState
                { $sel:dstAccepts:DState :: [Accept m]
dstAccepts = [Accept m
x]
                , $sel:dstTrans:DState :: IntMap StateNum
dstTrans = forall a. IntMap a
IntMap.empty
                , $sel:dstOtherTrans:DState :: Maybe StateNum
dstOtherTrans = forall a. Maybe a
Nothing
                }
            do \ds :: DFAState m
ds@DState { [Accept m]
dstAccepts :: [Accept m]
$sel:dstAccepts:DState :: forall a. DFAState a -> [Accept a]
dstAccepts } -> DFAState m
ds
                { $sel:dstAccepts:DState :: [Accept m]
dstAccepts = forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
List.insertBy
                    forall a. Accept a -> Accept a -> Ordering
Pattern.compareAcceptsByPriority
                    Accept m
x
                    [Accept m]
dstAccepts
                }
            do StateMap (DFAState m)
n

initial :: MState.StateNum -> Pattern.StartState -> DFABuilder m ()
initial :: forall m. StateNum -> StartState -> DFABuilder m ()
initial StateNum
s StartState
x = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \ctx0 :: DFABuilderContext m
ctx0@DFABuilderContext{ EnumMap StartState StateNum
dfaBCtxInitials :: EnumMap StartState StateNum
$sel:dfaBCtxInitials:DFABuilderContext :: forall m. DFABuilderContext m -> EnumMap StartState StateNum
dfaBCtxInitials } -> DFABuilderContext m
ctx0
    { $sel:dfaBCtxInitials:DFABuilderContext :: EnumMap StartState StateNum
dfaBCtxInitials = forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EnumMap.insert StartState
x StateNum
s EnumMap StartState StateNum
dfaBCtxInitials
    }