module Language.Lexer.Tlex.Machine.NFA
    (
        NFA (..),
        NFAState(..),
        NFAStateTrans(..),
        NFABuilder,
        NFABuilderContext,
        buildNFA,
        epsilonClosed,
        newStateNum,
        epsilonTrans,
        condTrans,
        accept,
        initial,
    ) where

import           Language.Lexer.Tlex.Prelude

import qualified Data.IntSet                         as IntSet
import qualified Language.Lexer.Tlex.Data.Graph      as Graph
import qualified Language.Lexer.Tlex.Machine.Pattern as Pattern
import qualified Language.Lexer.Tlex.Machine.State   as MState


data NFA a = NFA
    { forall a. NFA a -> [(StateNum, StartState)]
nfaInitials :: [(MState.StateNum, Pattern.StartState)]
    , forall a. NFA a -> StateArray (NFAState a)
nfaTrans    :: MState.StateArray (NFAState a)
    }
    deriving (NFA a -> NFA a -> Bool
forall a. Eq a => NFA a -> NFA a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NFA a -> NFA a -> Bool
$c/= :: forall a. Eq a => NFA a -> NFA a -> Bool
== :: NFA a -> NFA a -> Bool
$c== :: forall a. Eq a => NFA a -> NFA a -> Bool
Eq, Int -> NFA a -> ShowS
forall a. Show a => Int -> NFA a -> ShowS
forall a. Show a => [NFA a] -> ShowS
forall a. Show a => NFA a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NFA a] -> ShowS
$cshowList :: forall a. Show a => [NFA a] -> ShowS
show :: NFA a -> String
$cshow :: forall a. Show a => NFA a -> String
showsPrec :: Int -> NFA a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> NFA a -> ShowS
Show, forall a b. a -> NFA b -> NFA a
forall a b. (a -> b) -> NFA a -> NFA 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 -> NFA b -> NFA a
$c<$ :: forall a b. a -> NFA b -> NFA a
fmap :: forall a b. (a -> b) -> NFA a -> NFA b
$cfmap :: forall a b. (a -> b) -> NFA a -> NFA b
Functor)

data NFAState a = NState
    { forall a. NFAState a -> [Accept a]
nstAccepts      :: [Pattern.Accept a]
    , forall a. NFAState a -> [StateNum]
nstEpsilonTrans :: [MState.StateNum]
    , forall a. NFAState a -> [NFAStateTrans]
nstTrans        :: [NFAStateTrans]
    }
    deriving (NFAState a -> NFAState a -> Bool
forall a. Eq a => NFAState a -> NFAState a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NFAState a -> NFAState a -> Bool
$c/= :: forall a. Eq a => NFAState a -> NFAState a -> Bool
== :: NFAState a -> NFAState a -> Bool
$c== :: forall a. Eq a => NFAState a -> NFAState a -> Bool
Eq, Int -> NFAState a -> ShowS
forall a. Show a => Int -> NFAState a -> ShowS
forall a. Show a => [NFAState a] -> ShowS
forall a. Show a => NFAState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NFAState a] -> ShowS
$cshowList :: forall a. Show a => [NFAState a] -> ShowS
show :: NFAState a -> String
$cshow :: forall a. Show a => NFAState a -> String
showsPrec :: Int -> NFAState a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> NFAState a -> ShowS
Show, forall a b. a -> NFAState b -> NFAState a
forall a b. (a -> b) -> NFAState a -> NFAState 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 -> NFAState b -> NFAState a
$c<$ :: forall a b. a -> NFAState b -> NFAState a
fmap :: forall a b. (a -> b) -> NFAState a -> NFAState b
$cfmap :: forall a b. (a -> b) -> NFAState a -> NFAState b
Functor)

data NFAStateTrans = NFAStateTrans
    { NFAStateTrans -> Bool
nstTransIsStraight :: Bool
    , NFAStateTrans -> IntSet
nstTransRange      :: IntSet.IntSet
    , NFAStateTrans -> StateNum
nstTransNextState  :: MState.StateNum
    }
    deriving (NFAStateTrans -> NFAStateTrans -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NFAStateTrans -> NFAStateTrans -> Bool
$c/= :: NFAStateTrans -> NFAStateTrans -> Bool
== :: NFAStateTrans -> NFAStateTrans -> Bool
$c== :: NFAStateTrans -> NFAStateTrans -> Bool
Eq, Int -> NFAStateTrans -> ShowS
[NFAStateTrans] -> ShowS
NFAStateTrans -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NFAStateTrans] -> ShowS
$cshowList :: [NFAStateTrans] -> ShowS
show :: NFAStateTrans -> String
$cshow :: NFAStateTrans -> String
showsPrec :: Int -> NFAStateTrans -> ShowS
$cshowsPrec :: Int -> NFAStateTrans -> ShowS
Show)

epsilonClosed :: NFA a -> NFA a
epsilonClosed :: forall a. NFA a -> NFA a
epsilonClosed nfa :: NFA a
nfa@NFA{ StateArray (NFAState a)
nfaTrans :: StateArray (NFAState a)
$sel:nfaTrans:NFA :: forall a. NFA a -> StateArray (NFAState a)
nfaTrans } = NFA a
nfa
    { $sel:nfaTrans:NFA :: StateArray (NFAState a)
nfaTrans = forall a. (StateNum -> a -> a) -> StateArray a -> StateArray a
MState.mapArrayWithIx StateNum -> NFAState a -> NFAState a
go StateArray (NFAState a)
nfaTrans
    }
    where
        go :: StateNum -> NFAState a -> NFAState a
go StateNum
v NFAState a
s = NFAState a
s
            { $sel:nstEpsilonTrans:NState :: [StateNum]
nstEpsilonTrans = StateGraph
gr StateGraph -> StateNum -> [StateNum]
`MState.indexGraph` StateNum
v
            }

        gr :: StateGraph
gr = (Graph -> Graph) -> StateGraph -> StateGraph
MState.liftGraphOp Graph -> Graph
Graph.transClosure
            do StateArray [StateNum] -> StateGraph
MState.stateArrayToGraph do forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. NFAState a -> [StateNum]
nstEpsilonTrans StateArray (NFAState a)
nfaTrans


data NFABuilderContext m = NFABuilderContext
    { forall m. NFABuilderContext m -> [(StateNum, StartState)]
nfaBCtxInitials     :: [(MState.StateNum, Pattern.StartState)]
    , forall m. NFABuilderContext m -> StateNum
nfaBCtxNextStateNum :: MState.StateNum
    , forall m. NFABuilderContext m -> StateMap (NFAState m)
nfaBCtxStateMap     :: MState.StateMap (NFAState m)
    }

type NFABuilder m = State (NFABuilderContext m)

buildNFA :: NFABuilder m () -> NFA m
buildNFA :: forall m. NFABuilder m () -> NFA m
buildNFA NFABuilder m ()
builder =
    let bctx :: NFABuilderContext m
bctx = forall s a. State s a -> s -> s
execState NFABuilder m ()
builder forall {m}. NFABuilderContext m
initialBCtx
        arr :: StateArray (NFAState m)
arr = forall a. StateNum -> StateMap a -> StateArray a
MState.totalStateMapToArray
            do forall m. NFABuilderContext m -> StateNum
nfaBCtxNextStateNum NFABuilderContext m
bctx
            do forall m. NFABuilderContext m -> StateMap (NFAState m)
nfaBCtxStateMap NFABuilderContext m
bctx
    in forall a. NFA a -> NFA a
epsilonClosed
        do NFA
            { $sel:nfaInitials:NFA :: [(StateNum, StartState)]
nfaInitials = forall m. NFABuilderContext m -> [(StateNum, StartState)]
nfaBCtxInitials NFABuilderContext m
bctx
            , $sel:nfaTrans:NFA :: StateArray (NFAState m)
nfaTrans = StateArray (NFAState m)
arr
            }
    where
        initialBCtx :: NFABuilderContext m
initialBCtx = NFABuilderContext
            { $sel:nfaBCtxInitials:NFABuilderContext :: [(StateNum, StartState)]
nfaBCtxInitials = []
            , $sel:nfaBCtxNextStateNum:NFABuilderContext :: StateNum
nfaBCtxNextStateNum = StateNum
MState.initialStateNum
            , $sel:nfaBCtxStateMap:NFABuilderContext :: StateMap (NFAState m)
nfaBCtxStateMap = forall a. StateMap a
MState.emptyMap
            }

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

epsilonTrans :: MState.StateNum -> MState.StateNum -> NFABuilder m ()
epsilonTrans :: forall m. StateNum -> StateNum -> NFABuilder m ()
epsilonTrans StateNum
sf StateNum
st
    | StateNum
sf forall a. Eq a => a -> a -> Bool
== StateNum
st  = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    | Bool
otherwise = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \ctx0 :: NFABuilderContext m
ctx0@NFABuilderContext{ StateMap (NFAState m)
nfaBCtxStateMap :: StateMap (NFAState m)
$sel:nfaBCtxStateMap:NFABuilderContext :: forall m. NFABuilderContext m -> StateMap (NFAState m)
nfaBCtxStateMap } -> NFABuilderContext m
ctx0
        { $sel:nfaBCtxStateMap:NFABuilderContext :: StateMap (NFAState m)
nfaBCtxStateMap = StateMap (NFAState m) -> StateMap (NFAState m)
addEpsTrans StateMap (NFAState m)
nfaBCtxStateMap
        }
    where
        addEpsTrans :: StateMap (NFAState m) -> StateMap (NFAState m)
addEpsTrans StateMap (NFAState m)
n = forall a. StateNum -> a -> (a -> a) -> StateMap a -> StateMap a
MState.insertOrUpdateMap StateNum
sf
            do NState
                { $sel:nstAccepts:NState :: [Accept m]
nstAccepts = []
                , $sel:nstEpsilonTrans:NState :: [StateNum]
nstEpsilonTrans = [StateNum
st]
                , $sel:nstTrans:NState :: [NFAStateTrans]
nstTrans = []
                }
            do \s :: NFAState m
s@NState{ [StateNum]
nstEpsilonTrans :: [StateNum]
$sel:nstEpsilonTrans:NState :: forall a. NFAState a -> [StateNum]
nstEpsilonTrans } -> NFAState m
s
                { $sel:nstEpsilonTrans:NState :: [StateNum]
nstEpsilonTrans = StateNum
stforall a. a -> [a] -> [a]
:[StateNum]
nstEpsilonTrans
                }
            do StateMap (NFAState m)
n

condTrans :: MState.StateNum -> NFAStateTrans -> NFABuilder m ()
condTrans :: forall m. StateNum -> NFAStateTrans -> NFABuilder m ()
condTrans StateNum
sf NFAStateTrans
st = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \ctx0 :: NFABuilderContext m
ctx0@NFABuilderContext{ StateMap (NFAState m)
nfaBCtxStateMap :: StateMap (NFAState m)
$sel:nfaBCtxStateMap:NFABuilderContext :: forall m. NFABuilderContext m -> StateMap (NFAState m)
nfaBCtxStateMap } -> NFABuilderContext m
ctx0
    { $sel:nfaBCtxStateMap:NFABuilderContext :: StateMap (NFAState m)
nfaBCtxStateMap = StateMap (NFAState m) -> StateMap (NFAState m)
addCondTrans StateMap (NFAState m)
nfaBCtxStateMap
    }
    where
        addCondTrans :: StateMap (NFAState m) -> StateMap (NFAState m)
addCondTrans StateMap (NFAState m)
n = forall a. StateNum -> a -> (a -> a) -> StateMap a -> StateMap a
MState.insertOrUpdateMap StateNum
sf
            do NState
                { $sel:nstAccepts:NState :: [Accept m]
nstAccepts = []
                , $sel:nstEpsilonTrans:NState :: [StateNum]
nstEpsilonTrans = []
                , $sel:nstTrans:NState :: [NFAStateTrans]
nstTrans = [NFAStateTrans
st]
                }
            do \s :: NFAState m
s@NState{ [NFAStateTrans]
nstTrans :: [NFAStateTrans]
$sel:nstTrans:NState :: forall a. NFAState a -> [NFAStateTrans]
nstTrans } -> NFAState m
s
                { $sel:nstTrans:NState :: [NFAStateTrans]
nstTrans = NFAStateTrans
stforall a. a -> [a] -> [a]
:[NFAStateTrans]
nstTrans
                }
            do StateMap (NFAState m)
n

accept :: MState.StateNum -> Pattern.Accept m -> NFABuilder m ()
accept :: forall m. StateNum -> Accept m -> NFABuilder m ()
accept StateNum
s Accept m
x = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \ctx0 :: NFABuilderContext m
ctx0@NFABuilderContext{ StateMap (NFAState m)
nfaBCtxStateMap :: StateMap (NFAState m)
$sel:nfaBCtxStateMap:NFABuilderContext :: forall m. NFABuilderContext m -> StateMap (NFAState m)
nfaBCtxStateMap } -> NFABuilderContext m
ctx0
    { $sel:nfaBCtxStateMap:NFABuilderContext :: StateMap (NFAState m)
nfaBCtxStateMap = StateMap (NFAState m) -> StateMap (NFAState m)
addAccept StateMap (NFAState m)
nfaBCtxStateMap
    }
    where
        addAccept :: StateMap (NFAState m) -> StateMap (NFAState m)
addAccept StateMap (NFAState m)
n = forall a. StateNum -> a -> (a -> a) -> StateMap a -> StateMap a
MState.insertOrUpdateMap StateNum
s
            do NState
                { $sel:nstAccepts:NState :: [Accept m]
nstAccepts = [Accept m
x]
                , $sel:nstEpsilonTrans:NState :: [StateNum]
nstEpsilonTrans = []
                , $sel:nstTrans:NState :: [NFAStateTrans]
nstTrans = []
                }
            do \ns :: NFAState m
ns@NState{ [Accept m]
nstAccepts :: [Accept m]
$sel:nstAccepts:NState :: forall a. NFAState a -> [Accept a]
nstAccepts } -> NFAState m
ns
                { $sel:nstAccepts:NState :: [Accept m]
nstAccepts = Accept m
xforall a. a -> [a] -> [a]
:[Accept m]
nstAccepts
                }
            do StateMap (NFAState m)
n

initial :: MState.StateNum -> Pattern.StartState -> NFABuilder m ()
initial :: forall m. StateNum -> StartState -> NFABuilder m ()
initial StateNum
s StartState
x = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \ctx0 :: NFABuilderContext m
ctx0@NFABuilderContext{ [(StateNum, StartState)]
nfaBCtxInitials :: [(StateNum, StartState)]
$sel:nfaBCtxInitials:NFABuilderContext :: forall m. NFABuilderContext m -> [(StateNum, StartState)]
nfaBCtxInitials } -> NFABuilderContext m
ctx0
    { $sel:nfaBCtxInitials:NFABuilderContext :: [(StateNum, StartState)]
nfaBCtxInitials = (StateNum
s, StartState
x)forall a. a -> [a] -> [a]
:[(StateNum, StartState)]
nfaBCtxInitials
    }