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
    { DFA a -> EnumMap StartState StateNum
dfaInitials :: EnumMap.EnumMap Pattern.StartState MState.StateNum
    , DFA a -> StateArray (DFAState a)
dfaTrans    :: MState.StateArray (DFAState a)
    }
    deriving (DFA a -> DFA a -> Bool
(DFA a -> DFA a -> Bool) -> (DFA a -> DFA a -> Bool) -> Eq (DFA a)
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
[DFA a] -> ShowS
DFA a -> String
(Int -> DFA a -> ShowS)
-> (DFA a -> String) -> ([DFA a] -> ShowS) -> Show (DFA a)
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, a -> DFA b -> DFA a
(a -> b) -> DFA a -> DFA b
(forall a b. (a -> b) -> DFA a -> DFA b)
-> (forall a b. a -> DFA b -> DFA a) -> Functor DFA
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
<$ :: a -> DFA b -> DFA a
$c<$ :: forall a b. a -> DFA b -> DFA a
fmap :: (a -> b) -> DFA a -> DFA b
$cfmap :: forall a b. (a -> b) -> DFA a -> DFA b
Functor)

data DFAState a = DState
    { DFAState a -> [Accept a]
dstAccepts    :: [Pattern.Accept a]
    , DFAState a -> IntMap StateNum
dstTrans      :: IntMap.IntMap MState.StateNum
    , DFAState a -> Maybe StateNum
dstOtherTrans :: Maybe MState.StateNum
    }
    deriving (DFAState a -> DFAState a -> Bool
(DFAState a -> DFAState a -> Bool)
-> (DFAState a -> DFAState a -> Bool) -> Eq (DFAState a)
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
[DFAState a] -> ShowS
DFAState a -> String
(Int -> DFAState a -> ShowS)
-> (DFAState a -> String)
-> ([DFAState a] -> ShowS)
-> Show (DFAState a)
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, a -> DFAState b -> DFAState a
(a -> b) -> DFAState a -> DFAState b
(forall a b. (a -> b) -> DFAState a -> DFAState b)
-> (forall a b. a -> DFAState b -> DFAState a) -> Functor DFAState
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
<$ :: a -> DFAState b -> DFAState a
$c<$ :: forall a b. a -> DFAState b -> DFAState a
fmap :: (a -> b) -> DFAState a -> DFAState b
$cfmap :: forall a b. (a -> b) -> DFAState a -> DFAState b
Functor)


data DFABuilderContext m = DFABuilderContext
    { DFABuilderContext m -> EnumMap StartState StateNum
dfaBCtxInitials     :: EnumMap.EnumMap Pattern.StartState MState.StateNum
    , DFABuilderContext m -> StateNum
dfaBCtxNextStateNum :: MState.StateNum
    , DFABuilderContext m -> StateMap (DFAState m)
dfaBCtxStateMap     :: MState.StateMap (DFAState m)
    }
    deriving (DFABuilderContext m -> DFABuilderContext m -> Bool
(DFABuilderContext m -> DFABuilderContext m -> Bool)
-> (DFABuilderContext m -> DFABuilderContext m -> Bool)
-> Eq (DFABuilderContext m)
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
[DFABuilderContext m] -> ShowS
DFABuilderContext m -> String
(Int -> DFABuilderContext m -> ShowS)
-> (DFABuilderContext m -> String)
-> ([DFABuilderContext m] -> ShowS)
-> Show (DFABuilderContext m)
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, a -> DFABuilderContext b -> DFABuilderContext a
(a -> b) -> DFABuilderContext a -> DFABuilderContext b
(forall a b.
 (a -> b) -> DFABuilderContext a -> DFABuilderContext b)
-> (forall a b. a -> DFABuilderContext b -> DFABuilderContext a)
-> Functor DFABuilderContext
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
<$ :: a -> DFABuilderContext b -> DFABuilderContext a
$c<$ :: forall a b. a -> DFABuilderContext b -> DFABuilderContext a
fmap :: (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 :: DFABuilder m () -> DFA m
buildDFA DFABuilder m ()
builder =
    let bctx :: DFABuilderContext m
bctx = DFABuilder m () -> DFABuilderContext m -> DFABuilderContext m
forall s a. State s a -> s -> s
execState DFABuilder m ()
builder DFABuilderContext m
forall m. DFABuilderContext m
initialBCtx
        arr :: StateArray (DFAState m)
arr = StateNum -> StateMap (DFAState m) -> StateArray (DFAState m)
forall a. StateNum -> StateMap a -> StateArray a
MState.totalStateMapToArray
            do DFABuilderContext m -> StateNum
forall m. DFABuilderContext m -> StateNum
dfaBCtxNextStateNum DFABuilderContext m
bctx
            do DFABuilderContext m -> StateMap (DFAState m)
forall m. DFABuilderContext m -> StateMap (DFAState m)
dfaBCtxStateMap DFABuilderContext m
bctx
    in DFA :: forall a.
EnumMap StartState StateNum -> StateArray (DFAState a) -> DFA a
DFA
        { $sel:dfaInitials:DFA :: EnumMap StartState StateNum
dfaInitials = DFABuilderContext m -> EnumMap StartState StateNum
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 :: forall m.
EnumMap StartState StateNum
-> StateNum -> StateMap (DFAState m) -> DFABuilderContext m
DFABuilderContext
            { $sel:dfaBCtxInitials:DFABuilderContext :: EnumMap StartState StateNum
dfaBCtxInitials = EnumMap StartState StateNum
forall k a. EnumMap k a
EnumMap.empty
            , $sel:dfaBCtxNextStateNum:DFABuilderContext :: StateNum
dfaBCtxNextStateNum = StateNum
MState.initialStateNum
            , $sel:dfaBCtxStateMap:DFABuilderContext :: StateMap (DFAState m)
dfaBCtxStateMap = StateMap (DFAState m)
forall a. StateMap a
MState.emptyMap
            }

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

insertTrans :: MState.StateNum -> DFAState m -> DFABuilder m ()
insertTrans :: StateNum -> DFAState m -> DFABuilder m ()
insertTrans StateNum
sf DFAState m
st = (DFABuilderContext m -> DFABuilderContext m) -> DFABuilder m ()
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 = StateNum
-> DFAState m -> StateMap (DFAState m) -> StateMap (DFAState m)
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 :: StateNum -> Accept m -> DFABuilder m ()
accept StateNum
s Accept m
x = (DFABuilderContext m -> DFABuilderContext m) -> DFABuilder m ()
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 = StateNum
-> DFAState m
-> (DFAState m -> DFAState m)
-> StateMap (DFAState m)
-> StateMap (DFAState m)
forall a. StateNum -> a -> (a -> a) -> StateMap a -> StateMap a
MState.insertOrUpdateMap StateNum
s
            do DState :: forall a.
[Accept a] -> IntMap StateNum -> Maybe StateNum -> DFAState a
DState
                { $sel:dstAccepts:DState :: [Accept m]
dstAccepts = [Accept m
x]
                , $sel:dstTrans:DState :: IntMap StateNum
dstTrans = IntMap StateNum
forall a. IntMap a
IntMap.empty
                , $sel:dstOtherTrans:DState :: Maybe StateNum
dstOtherTrans = Maybe StateNum
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 = (Accept m -> Accept m -> Ordering)
-> Accept m -> [Accept m] -> [Accept m]
forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
List.insertBy
                    Accept m -> Accept m -> Ordering
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 :: StateNum -> StartState -> DFABuilder m ()
initial StateNum
s StartState
x = (DFABuilderContext m -> DFABuilderContext m) -> DFABuilder m ()
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 = StartState
-> StateNum
-> EnumMap StartState StateNum
-> EnumMap StartState StateNum
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EnumMap.insert StartState
x StateNum
s EnumMap StartState StateNum
dfaBCtxInitials
    }