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 :: AcceptPriority -> StateNum -> ScanRule e m -> NFABuilder m () scanRule2Nfa AcceptPriority p StateNum b ScanRule e m r = do StateNum e <- NFABuilder m StateNum forall m. NFABuilder m StateNum NFA.newStateNum StateNum -> StateNum -> Pattern e -> NFABuilder m () forall e m. Enum e => StateNum -> StateNum -> Pattern e -> NFABuilder m () Pattern2Nfa.pattern2Nfa StateNum b StateNum e do ScanRule e m -> Pattern e forall e a. ScanRule e a -> Pattern e Tlex.scanRulePattern ScanRule e m r StateNum -> Accept m -> NFABuilder m () forall m. StateNum -> Accept m -> NFABuilder m () NFA.accept StateNum e do Accept :: forall a. AcceptPriority -> a -> Accept a Tlex.Accept { $sel:accPriority:Accept :: AcceptPriority accPriority = AcceptPriority p , $sel:accSemanticAction:Accept :: m accSemanticAction = ScanRule e m -> m forall e a. ScanRule e a -> a Tlex.scanRuleSemanticAction ScanRule e m r } scanner2Nfa :: Enum e => Tlex.Scanner e m -> NFA.NFABuilder m () scanner2Nfa :: Scanner e m -> NFABuilder m () scanner2Nfa Tlex.Scanner{ [ScanRule e m] $sel:scannerRules:Scanner :: forall e a. Scanner e a -> [ScanRule e a] scannerRules :: [ScanRule e m] scannerRules } = ((AcceptPriority, [StateNum], EnumMap StartState StateNum) -> ScanRule e m -> StateT (NFABuilderContext m) Identity (AcceptPriority, [StateNum], EnumMap StartState StateNum)) -> (AcceptPriority, [StateNum], EnumMap StartState StateNum) -> [ScanRule e m] -> NFABuilder m () 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 -> AcceptPriority -> [StateNum] -> EnumMap StartState StateNum -> ScanRule e m -> StateT (NFABuilderContext m) Identity (AcceptPriority, [StateNum], EnumMap StartState StateNum) forall e a. Enum e => AcceptPriority -> [StateNum] -> EnumMap StartState StateNum -> ScanRule e a -> StateT (NFABuilderContext a) Identity (AcceptPriority, [StateNum], EnumMap StartState StateNum) aggScanRule AcceptPriority p [StateNum] bs EnumMap StartState StateNum is ScanRule e m scanRule do (AcceptPriority Pattern.mostPriority, [], EnumMap StartState StateNum forall k a. EnumMap k a EnumMap.empty) do [ScanRule e m] scannerRules where aggScanRule :: AcceptPriority -> [StateNum] -> EnumMap StartState StateNum -> ScanRule e a -> StateT (NFABuilderContext a) Identity (AcceptPriority, [StateNum], EnumMap StartState StateNum) aggScanRule AcceptPriority p0 [StateNum] bs0 EnumMap StartState StateNum is0 ScanRule e a scanRule = do StateNum b <- NFABuilder a StateNum forall m. NFABuilder m StateNum NFA.newStateNum AcceptPriority -> StateNum -> ScanRule e a -> NFABuilder a () forall e m. Enum e => AcceptPriority -> StateNum -> ScanRule e m -> NFABuilder m () scanRule2Nfa AcceptPriority p0 StateNum b ScanRule e a scanRule EnumMap StartState StateNum is1 <- EnumMap StartState StateNum -> StateNum -> [StartState] -> StateT (NFABuilderContext a) Identity (EnumMap StartState StateNum) 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 ScanRule e a -> [StartState] forall e a. ScanRule e a -> [StartState] Tlex.scanRuleStartStates ScanRule e a scanRule (AcceptPriority, [StateNum], EnumMap StartState StateNum) -> StateT (NFABuilderContext a) Identity (AcceptPriority, [StateNum], EnumMap StartState StateNum) forall (f :: * -> *) a. Applicative f => a -> f a pure (AcceptPriority -> AcceptPriority forall a. Enum a => a -> a succ AcceptPriority p0, StateNum bStateNum -> [StateNum] -> [StateNum] forall 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 = (EnumMap StartState StateNum -> StartState -> StateT (NFABuilderContext m) Identity (EnumMap StartState StateNum)) -> EnumMap StartState StateNum -> t StartState -> StateT (NFABuilderContext m) Identity (EnumMap StartState StateNum) 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 StartState -> EnumMap StartState StateNum -> Maybe StateNum forall k a. Enum k => k -> EnumMap k a -> Maybe a EnumMap.lookup StartState s EnumMap StartState StateNum is of Just StateNum x -> (EnumMap StartState StateNum, StateNum) -> StateT (NFABuilderContext m) Identity (EnumMap StartState StateNum, StateNum) forall (f :: * -> *) a. Applicative f => a -> f a pure (EnumMap StartState StateNum is, StateNum x) Maybe StateNum Nothing -> do StateNum x <- NFABuilder m StateNum forall m. NFABuilder m StateNum NFA.newStateNum StateNum -> StartState -> NFABuilder m () forall m. StateNum -> StartState -> NFABuilder m () NFA.initial StateNum x StartState s (EnumMap StartState StateNum, StateNum) -> StateT (NFABuilderContext m) Identity (EnumMap StartState StateNum, StateNum) forall (f :: * -> *) a. Applicative f => a -> f a pure (StartState -> StateNum -> EnumMap StartState StateNum -> EnumMap StartState StateNum 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) StateNum -> StateNum -> NFABuilder m () forall m. StateNum -> StateNum -> NFABuilder m () NFA.epsilonTrans StateNum sn StateNum b EnumMap StartState StateNum -> StateT (NFABuilderContext m) Identity (EnumMap StartState StateNum) forall (f :: * -> *) a. Applicative f => a -> f a pure EnumMap StartState StateNum is' do EnumMap StartState StateNum is0 do t StartState ss