module Language.Lexer.Tlex.Pipeline.Scanner2Nfa (
    scanRule2Nfa,
    scanner2Nfa,
) where

import           Language.Lexer.Tlex.Prelude

import qualified Data.EnumMap.Strict                      as EnumMap
import qualified Language.Lexer.Tlex.Machine.NFA          as NFA
import qualified Language.Lexer.Tlex.Machine.Pattern      as Pattern
import qualified Language.Lexer.Tlex.Machine.State        as MState
import qualified Language.Lexer.Tlex.Pipeline.Pattern2Nfa as Pattern2Nfa
import qualified Language.Lexer.Tlex.Syntax               as Tlex


scanRule2Nfa
    :: Enum e
    => Pattern.AcceptPriority -> MState.StateNum -> Tlex.ScanRule e m
    -> NFA.NFABuilder m ()
scanRule2Nfa :: forall e m.
Enum e =>
AcceptPriority -> StateNum -> ScanRule e m -> NFABuilder m ()
scanRule2Nfa AcceptPriority
p StateNum
b ScanRule e m
r = do
    StateNum
e <- forall m. NFABuilder m StateNum
NFA.newStateNum
    forall e m.
Enum e =>
StateNum -> StateNum -> Pattern e -> NFABuilder m ()
Pattern2Nfa.pattern2Nfa StateNum
b StateNum
e do forall unit action. ScanRule unit action -> Pattern unit
Tlex.scanRulePattern ScanRule e m
r

    forall m. StateNum -> Accept m -> NFABuilder m ()
NFA.accept StateNum
e
        do Tlex.Accept
            { $sel:accPriority:Accept :: AcceptPriority
accPriority = AcceptPriority
p
            , $sel:accSemanticAction:Accept :: m
accSemanticAction = forall unit action. ScanRule unit action -> action
Tlex.scanRuleSemanticAction ScanRule e m
r
            }

scanner2Nfa :: Enum e => Tlex.Scanner e m -> NFA.NFABuilder m ()
scanner2Nfa :: forall e m. Enum e => Scanner e m -> NFABuilder m ()
scanner2Nfa Tlex.Scanner{ [ScanRule e m]
$sel:scannerRules:Scanner :: forall unit action. Scanner unit action -> [ScanRule unit action]
scannerRules :: [ScanRule e m]
scannerRules } = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_
    do \(AcceptPriority
p, [StateNum]
bs, EnumMap StartState StateNum
is) ScanRule e m
scanRule -> forall {unit} {action}.
Enum unit =>
AcceptPriority
-> [StateNum]
-> EnumMap StartState StateNum
-> ScanRule unit action
-> StateT
     (NFABuilderContext action)
     Identity
     (AcceptPriority, [StateNum], EnumMap StartState StateNum)
aggScanRule AcceptPriority
p [StateNum]
bs EnumMap StartState StateNum
is ScanRule e m
scanRule
    do (AcceptPriority
Pattern.mostPriority, [], forall k a. EnumMap k a
EnumMap.empty)
    do [ScanRule e m]
scannerRules
    where
        aggScanRule :: AcceptPriority
-> [StateNum]
-> EnumMap StartState StateNum
-> ScanRule unit action
-> StateT
     (NFABuilderContext action)
     Identity
     (AcceptPriority, [StateNum], EnumMap StartState StateNum)
aggScanRule AcceptPriority
p0 [StateNum]
bs0 EnumMap StartState StateNum
is0 ScanRule unit action
scanRule = do
            StateNum
b <- forall m. NFABuilder m StateNum
NFA.newStateNum
            forall e m.
Enum e =>
AcceptPriority -> StateNum -> ScanRule e m -> NFABuilder m ()
scanRule2Nfa AcceptPriority
p0 StateNum
b ScanRule unit action
scanRule
            EnumMap StartState StateNum
is1 <- forall {t :: * -> *} {m}.
Foldable t =>
EnumMap StartState StateNum
-> StateNum
-> t StartState
-> StateT
     (NFABuilderContext m) Identity (EnumMap StartState StateNum)
registerStartState EnumMap StartState StateNum
is0 StateNum
b do forall unit action. ScanRule unit action -> [StartState]
Tlex.scanRuleStartStates ScanRule unit action
scanRule
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Enum a => a -> a
succ AcceptPriority
p0, StateNum
bforall a. a -> [a] -> [a]
:[StateNum]
bs0, EnumMap StartState StateNum
is1)

        registerStartState :: EnumMap StartState StateNum
-> StateNum
-> t StartState
-> StateT
     (NFABuilderContext m) Identity (EnumMap StartState StateNum)
registerStartState EnumMap StartState StateNum
is0 StateNum
b t StartState
ss = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
            do \EnumMap StartState StateNum
is StartState
s -> do
                (EnumMap StartState StateNum
is', StateNum
sn) <- case forall k a. Enum k => k -> EnumMap k a -> Maybe a
EnumMap.lookup StartState
s EnumMap StartState StateNum
is of
                    Just StateNum
x  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (EnumMap StartState StateNum
is, StateNum
x)
                    Maybe StateNum
Nothing -> do
                        StateNum
x <- forall m. NFABuilder m StateNum
NFA.newStateNum
                        forall m. StateNum -> StartState -> NFABuilder m ()
NFA.initial StateNum
x StartState
s
                        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EnumMap.insert StartState
s StateNum
x EnumMap StartState StateNum
is, StateNum
x)
                forall m. StateNum -> StateNum -> NFABuilder m ()
NFA.epsilonTrans StateNum
sn StateNum
b
                forall (f :: * -> *) a. Applicative f => a -> f a
pure EnumMap StartState StateNum
is'
            do EnumMap StartState StateNum
is0
            do t StartState
ss