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

data NFAState a = NState
    { NFAState a -> [Accept a]
nstAccepts      :: [Pattern.Accept a]
    , NFAState a -> [StateNum]
nstEpsilonTrans :: [MState.StateNum]
    , NFAState a -> [NFAStateTrans]
nstTrans        :: [NFAStateTrans]
    }
    deriving (NFAState a -> NFAState a -> Bool
(NFAState a -> NFAState a -> Bool)
-> (NFAState a -> NFAState a -> Bool) -> Eq (NFAState a)
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
[NFAState a] -> ShowS
NFAState a -> String
(Int -> NFAState a -> ShowS)
-> (NFAState a -> String)
-> ([NFAState a] -> ShowS)
-> Show (NFAState a)
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, a -> NFAState b -> NFAState a
(a -> b) -> NFAState a -> NFAState b
(forall a b. (a -> b) -> NFAState a -> NFAState b)
-> (forall a b. a -> NFAState b -> NFAState a) -> Functor NFAState
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
<$ :: a -> NFAState b -> NFAState a
$c<$ :: forall a b. a -> NFAState b -> NFAState a
fmap :: (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
(NFAStateTrans -> NFAStateTrans -> Bool)
-> (NFAStateTrans -> NFAStateTrans -> Bool) -> Eq NFAStateTrans
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
(Int -> NFAStateTrans -> ShowS)
-> (NFAStateTrans -> String)
-> ([NFAStateTrans] -> ShowS)
-> Show NFAStateTrans
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 :: 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 = (StateNum -> NFAState a -> NFAState a)
-> StateArray (NFAState a) -> StateArray (NFAState a)
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 (NFAState a -> [StateNum])
-> StateArray (NFAState a) -> StateArray [StateNum]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NFAState a -> [StateNum]
forall a. NFAState a -> [StateNum]
nstEpsilonTrans StateArray (NFAState a)
nfaTrans


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

type NFABuilder m = State (NFABuilderContext m)

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

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

epsilonTrans :: MState.StateNum -> MState.StateNum -> NFABuilder m ()
epsilonTrans :: StateNum -> StateNum -> NFABuilder m ()
epsilonTrans StateNum
sf StateNum
st
    | StateNum
sf StateNum -> StateNum -> Bool
forall a. Eq a => a -> a -> Bool
== StateNum
st  = () -> NFABuilder m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    | Bool
otherwise = (NFABuilderContext m -> NFABuilderContext m) -> NFABuilder m ()
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 = StateNum
-> NFAState m
-> (NFAState m -> NFAState m)
-> StateMap (NFAState m)
-> StateMap (NFAState m)
forall a. StateNum -> a -> (a -> a) -> StateMap a -> StateMap a
MState.insertOrUpdateMap StateNum
sf
            do NState :: forall a. [Accept a] -> [StateNum] -> [NFAStateTrans] -> NFAState a
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
stStateNum -> [StateNum] -> [StateNum]
forall a. a -> [a] -> [a]
:[StateNum]
nstEpsilonTrans
                }
            do StateMap (NFAState m)
n

condTrans :: MState.StateNum -> NFAStateTrans -> NFABuilder m ()
condTrans :: StateNum -> NFAStateTrans -> NFABuilder m ()
condTrans StateNum
sf NFAStateTrans
st = (NFABuilderContext m -> NFABuilderContext m) -> NFABuilder m ()
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 = StateNum
-> NFAState m
-> (NFAState m -> NFAState m)
-> StateMap (NFAState m)
-> StateMap (NFAState m)
forall a. StateNum -> a -> (a -> a) -> StateMap a -> StateMap a
MState.insertOrUpdateMap StateNum
sf
            do NState :: forall a. [Accept a] -> [StateNum] -> [NFAStateTrans] -> NFAState a
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
stNFAStateTrans -> [NFAStateTrans] -> [NFAStateTrans]
forall a. a -> [a] -> [a]
:[NFAStateTrans]
nstTrans
                }
            do StateMap (NFAState m)
n

accept :: MState.StateNum -> Pattern.Accept m -> NFABuilder m ()
accept :: StateNum -> Accept m -> NFABuilder m ()
accept StateNum
s Accept m
x = (NFABuilderContext m -> NFABuilderContext m) -> NFABuilder m ()
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 = StateNum
-> NFAState m
-> (NFAState m -> NFAState m)
-> StateMap (NFAState m)
-> StateMap (NFAState m)
forall a. StateNum -> a -> (a -> a) -> StateMap a -> StateMap a
MState.insertOrUpdateMap StateNum
s
            do NState :: forall a. [Accept a] -> [StateNum] -> [NFAStateTrans] -> NFAState a
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
xAccept m -> [Accept m] -> [Accept m]
forall a. a -> [a] -> [a]
:[Accept m]
nstAccepts
                }
            do StateMap (NFAState m)
n

initial :: MState.StateNum -> Pattern.StartState -> NFABuilder m ()
initial :: StateNum -> StartState -> NFABuilder m ()
initial StateNum
s StartState
x = (NFABuilderContext m -> NFABuilderContext m) -> NFABuilder m ()
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)(StateNum, StartState)
-> [(StateNum, StartState)] -> [(StateNum, StartState)]
forall a. a -> [a] -> [a]
:[(StateNum, StartState)]
nfaBCtxInitials
    }