module Language.Lexer.Tlex.Pipeline.MinDfa (
    minDfa,
) where

import           Language.Lexer.Tlex.Prelude

import qualified Data.HashMap.Strict                 as HashMap
import qualified Data.HashSet                        as HashSet
import qualified Data.IntMap.Strict                  as IntMap
import qualified Language.Lexer.Tlex.Data.EnumMap    as EnumMap
import qualified Language.Lexer.Tlex.Machine.DFA     as DFA
import qualified Language.Lexer.Tlex.Machine.Pattern as Pattern
import qualified Language.Lexer.Tlex.Machine.State   as MState


minDfa :: DFA.DFA a -> DFA.DFA a
minDfa :: DFA a -> DFA a
minDfa DFA a
dfa = DFABuilder a () -> DFA a
forall m. DFABuilder m () -> DFA m
DFA.buildDFA
    do (DFABuilderContext a -> DFABuilderContext a) -> DFABuilder a ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \DFABuilderContext a
dfaBuilderCtx0 -> MinDfaContext a -> DFABuilderContext a
forall m. MinDfaContext m -> DFABuilderContext m
minDfaCtxDFABuilderCtx
        do State (MinDfaContext a) () -> MinDfaContext a -> MinDfaContext a
forall s a. State s a -> s -> s
execState
            do DFA a -> State (MinDfaContext a) ()
forall a. DFA a -> MinDfaM a ()
minDfaM DFA a
dfa
            do MinDfaContext :: forall m.
StateMap StateNum -> DFABuilderContext m -> MinDfaContext m
MinDfaContext
                { $sel:minDfaCtxStateMap:MinDfaContext :: StateMap StateNum
minDfaCtxStateMap = StateMap StateNum
forall a. StateMap a
MState.emptyMap
                , $sel:minDfaCtxDFABuilderCtx:MinDfaContext :: DFABuilderContext a
minDfaCtxDFABuilderCtx = DFABuilderContext a
dfaBuilderCtx0
                }


data MinDfaContext m = MinDfaContext
    { MinDfaContext m -> StateMap StateNum
minDfaCtxStateMap      :: MState.StateMap MState.StateNum
    , MinDfaContext m -> DFABuilderContext m
minDfaCtxDFABuilderCtx :: DFA.DFABuilderContext m
    }
    deriving (MinDfaContext m -> MinDfaContext m -> Bool
(MinDfaContext m -> MinDfaContext m -> Bool)
-> (MinDfaContext m -> MinDfaContext m -> Bool)
-> Eq (MinDfaContext m)
forall m. Eq m => MinDfaContext m -> MinDfaContext m -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MinDfaContext m -> MinDfaContext m -> Bool
$c/= :: forall m. Eq m => MinDfaContext m -> MinDfaContext m -> Bool
== :: MinDfaContext m -> MinDfaContext m -> Bool
$c== :: forall m. Eq m => MinDfaContext m -> MinDfaContext m -> Bool
Eq, Int -> MinDfaContext m -> ShowS
[MinDfaContext m] -> ShowS
MinDfaContext m -> String
(Int -> MinDfaContext m -> ShowS)
-> (MinDfaContext m -> String)
-> ([MinDfaContext m] -> ShowS)
-> Show (MinDfaContext m)
forall m. Show m => Int -> MinDfaContext m -> ShowS
forall m. Show m => [MinDfaContext m] -> ShowS
forall m. Show m => MinDfaContext m -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MinDfaContext m] -> ShowS
$cshowList :: forall m. Show m => [MinDfaContext m] -> ShowS
show :: MinDfaContext m -> String
$cshow :: forall m. Show m => MinDfaContext m -> String
showsPrec :: Int -> MinDfaContext m -> ShowS
$cshowsPrec :: forall m. Show m => Int -> MinDfaContext m -> ShowS
Show, a -> MinDfaContext b -> MinDfaContext a
(a -> b) -> MinDfaContext a -> MinDfaContext b
(forall a b. (a -> b) -> MinDfaContext a -> MinDfaContext b)
-> (forall a b. a -> MinDfaContext b -> MinDfaContext a)
-> Functor MinDfaContext
forall a b. a -> MinDfaContext b -> MinDfaContext a
forall a b. (a -> b) -> MinDfaContext a -> MinDfaContext b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MinDfaContext b -> MinDfaContext a
$c<$ :: forall a b. a -> MinDfaContext b -> MinDfaContext a
fmap :: (a -> b) -> MinDfaContext a -> MinDfaContext b
$cfmap :: forall a b. (a -> b) -> MinDfaContext a -> MinDfaContext b
Functor)

type MinDfaM m = State (MinDfaContext m)

liftBuilderOp :: DFA.DFABuilder m a -> MinDfaM m a
liftBuilderOp :: DFABuilder m a -> MinDfaM m a
liftBuilderOp DFABuilder m a
builder = do
    MinDfaContext m
ctx0 <- StateT (MinDfaContext m) Identity (MinDfaContext m)
forall (m :: * -> *) s. Monad m => StateT s m s
get
    let (a
x, DFABuilderContext m
builderCtx1) = DFABuilder m a -> DFABuilderContext m -> (a, DFABuilderContext m)
forall s a. State s a -> s -> (a, s)
runState DFABuilder m a
builder do MinDfaContext m -> DFABuilderContext m
forall m. MinDfaContext m -> DFABuilderContext m
minDfaCtxDFABuilderCtx MinDfaContext m
ctx0
    MinDfaContext m -> StateT (MinDfaContext m) Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do MinDfaContext m
ctx0
            { $sel:minDfaCtxDFABuilderCtx:MinDfaContext :: DFABuilderContext m
minDfaCtxDFABuilderCtx = DFABuilderContext m
builderCtx1
            }
    a -> MinDfaM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

registerNewState :: MState.StateNum -> MinDfaM m MState.StateNum
registerNewState :: StateNum -> MinDfaM m StateNum
registerNewState StateNum
r = do
    StateNum
sn <- DFABuilder m StateNum -> MinDfaM m StateNum
forall m a. DFABuilder m a -> MinDfaM m a
liftBuilderOp DFABuilder m StateNum
forall m. DFABuilder m StateNum
DFA.newStateNum
    (MinDfaContext m -> MinDfaContext m)
-> StateT (MinDfaContext m) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \ctx0 :: MinDfaContext m
ctx0@MinDfaContext{ StateMap StateNum
minDfaCtxStateMap :: StateMap StateNum
$sel:minDfaCtxStateMap:MinDfaContext :: forall m. MinDfaContext m -> StateMap StateNum
minDfaCtxStateMap } -> MinDfaContext m
ctx0
        { $sel:minDfaCtxStateMap:MinDfaContext :: StateMap StateNum
minDfaCtxStateMap = StateNum -> StateNum -> StateMap StateNum -> StateMap StateNum
forall a. StateNum -> a -> StateMap a -> StateMap a
MState.insertMap StateNum
r StateNum
sn StateMap StateNum
minDfaCtxStateMap
        }
    StateNum -> MinDfaM m StateNum
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateNum
sn

getOrRegisterState :: MState.StateNum -> MinDfaM m MState.StateNum
getOrRegisterState :: StateNum -> MinDfaM m StateNum
getOrRegisterState StateNum
r = do
    MinDfaContext m
ctx0 <- StateT (MinDfaContext m) Identity (MinDfaContext m)
forall (m :: * -> *) s. Monad m => StateT s m s
get
    case StateNum -> StateMap StateNum -> Maybe StateNum
forall a. StateNum -> StateMap a -> Maybe a
MState.lookupMap StateNum
r do MinDfaContext m -> StateMap StateNum
forall m. MinDfaContext m -> StateMap StateNum
minDfaCtxStateMap MinDfaContext m
ctx0 of
        Just StateNum
sn -> StateNum -> MinDfaM m StateNum
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateNum
sn
        Maybe StateNum
Nothing -> StateNum -> MinDfaM m StateNum
forall m. StateNum -> MinDfaM m StateNum
registerNewState StateNum
r

minDfaM :: DFA.DFA a -> MinDfaM a ()
minDfaM :: DFA a -> MinDfaM a ()
minDfaM dfa :: DFA a
dfa@DFA.DFA{ StateArray (DFAState a)
$sel:dfaTrans:DFA :: forall a. DFA a -> StateArray (DFAState a)
dfaTrans :: StateArray (DFAState a)
dfaTrans } = do
    [(StartState, StateNum)]
-> ((StartState, StateNum) -> MinDfaM a ()) -> MinDfaM a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
        do EnumMap StartState StateNum -> [(StartState, StateNum)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EnumMap.assocs do DFA a -> EnumMap StartState StateNum
forall a. DFA a -> EnumMap StartState StateNum
DFA.dfaInitials DFA a
dfa
        do \(StartState
startS, StateNum
sn) -> do
            StateNum
newSn <- StateNum -> MinDfaM a StateNum
getOrRegisterStateByOldState StateNum
sn
            DFABuilder a () -> MinDfaM a ()
forall m a. DFABuilder m a -> MinDfaM m a
liftBuilderOp do StateNum -> StartState -> DFABuilder a ()
forall m. StateNum -> StartState -> DFABuilder m ()
DFA.initial StateNum
newSn StartState
startS

    [(StateNum, StateSet)]
-> ((StateNum, StateSet) -> MinDfaM a ()) -> MinDfaM a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
        do StateMap StateSet -> [(StateNum, StateSet)]
forall a. StateMap a -> [(StateNum, a)]
MState.assocsMap do Partition -> StateMap StateSet
partitionMember Partition
p
        do \(StateNum
r, StateSet
ss) -> do
            StateNum
newSn <- StateNum -> MinDfaM a StateNum
forall m. StateNum -> MinDfaM m StateNum
getOrRegisterState StateNum
r
            DFAState a
newDst <- StateSet -> MinDfaM a (DFAState a)
buildDFAState StateSet
ss
            DFABuilder a () -> MinDfaM a ()
forall m a. DFABuilder m a -> MinDfaM m a
liftBuilderOp do StateNum -> DFAState a -> DFABuilder a ()
forall m. StateNum -> DFAState m -> DFABuilder m ()
DFA.insertTrans StateNum
newSn DFAState a
newDst
    where
        p :: Partition
p = DFA a -> Partition
forall a. DFA a -> Partition
buildPartition DFA a
dfa

        getOrRegisterStateByOldState :: StateNum -> MinDfaM a StateNum
getOrRegisterStateByOldState StateNum
oldSn =
            let r :: StateNum
r = case StateNum -> StateMap StateNum -> Maybe StateNum
forall a. StateNum -> StateMap a -> Maybe a
MState.lookupMap StateNum
oldSn do Partition -> StateMap StateNum
partitionMap Partition
p of
                    Maybe StateNum
Nothing -> String -> StateNum
forall a. HasCallStack => String -> a
error String
"unreachable"
                    Just StateNum
s  -> StateNum
s
            in StateNum -> MinDfaM a StateNum
forall m. StateNum -> MinDfaM m StateNum
getOrRegisterState StateNum
r

        buildDFAState :: StateSet -> MinDfaM a (DFAState a)
buildDFAState StateSet
ss = DFAStateBuilder a () -> MinDfaM a (DFAState a)
forall a. DFAStateBuilder a () -> MinDfaM a (DFAState a)
buildDst do
            [StateNum]
-> (StateNum -> DFAStateBuilder a ()) -> DFAStateBuilder a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
                do StateSet -> [StateNum]
MState.setToList StateSet
ss
                do \StateNum
s -> do
                    let dst :: DFAState a
dst = StateArray (DFAState a) -> StateNum -> DFAState a
forall a. StateArray a -> StateNum -> a
MState.indexArray StateArray (DFAState a)
dfaTrans StateNum
s
                    [Accept a]
-> (Accept a -> DFAStateBuilder a ()) -> DFAStateBuilder a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
                        do DFAState a -> [Accept a]
forall a. DFAState a -> [Accept a]
DFA.dstAccepts DFAState a
dst
                        do \Accept a
acc -> Accept a -> DFAStateBuilder a ()
forall a. Accept a -> DFAStateBuilder a ()
insertAcceptToDst Accept a
acc

                    [(Int, StateNum)]
-> ((Int, StateNum) -> DFAStateBuilder a ())
-> DFAStateBuilder a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
                        do IntMap StateNum -> [(Int, StateNum)]
forall a. IntMap a -> [(Int, a)]
IntMap.assocs do DFAState a -> IntMap StateNum
forall a. DFAState a -> IntMap StateNum
DFA.dstTrans DFAState a
dst
                        do \(Int
c, StateNum
sn) -> do
                            DFAStateBuilderContext a
ctx0 <- StateT
  (DFAStateBuilderContext a) Identity (DFAStateBuilderContext a)
forall (m :: * -> *) s. Monad m => StateT s m s
get
                            case Int -> IntMap StateNum -> Maybe StateNum
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
c do DFAStateBuilderContext a -> IntMap StateNum
forall a. DFAStateBuilderContext a -> IntMap StateNum
dstBuilderCtxTrans DFAStateBuilderContext a
ctx0 of
                                Just{}  -> () -> DFAStateBuilder a ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                                Maybe StateNum
Nothing -> do
                                    StateNum
newSn <- MinDfaM a StateNum -> DFAStateBuilder a StateNum
forall m a. MinDfaM m a -> DFAStateBuilder m a
liftMinDfaOp do StateNum -> MinDfaM a StateNum
getOrRegisterStateByOldState StateNum
sn
                                    (DFAStateBuilderContext a -> DFAStateBuilderContext a)
-> DFAStateBuilder a ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \DFAStateBuilderContext a
ctx -> DFAStateBuilderContext a
ctx
                                        { $sel:dstBuilderCtxTrans:DStateBuilderContext :: IntMap StateNum
dstBuilderCtxTrans = Int -> StateNum -> IntMap StateNum -> IntMap StateNum
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
c StateNum
newSn
                                            do DFAStateBuilderContext a -> IntMap StateNum
forall a. DFAStateBuilderContext a -> IntMap StateNum
dstBuilderCtxTrans DFAStateBuilderContext a
ctx
                                        }

                    case DFAState a -> Maybe StateNum
forall a. DFAState a -> Maybe StateNum
DFA.dstOtherTrans DFAState a
dst of
                        Maybe StateNum
Nothing -> () -> DFAStateBuilder a ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                        Just StateNum
sn -> do
                            DFAStateBuilderContext a
ctx <- StateT
  (DFAStateBuilderContext a) Identity (DFAStateBuilderContext a)
forall (m :: * -> *) s. Monad m => StateT s m s
get
                            case DFAStateBuilderContext a -> Maybe StateNum
forall a. DFAStateBuilderContext a -> Maybe StateNum
dstBuilderCtxOtherTrans DFAStateBuilderContext a
ctx of
                                Just{}  -> () -> DFAStateBuilder a ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                                Maybe StateNum
Nothing -> do
                                    StateNum
newSn <- MinDfaM a StateNum -> DFAStateBuilder a StateNum
forall m a. MinDfaM m a -> DFAStateBuilder m a
liftMinDfaOp do StateNum -> MinDfaM a StateNum
getOrRegisterStateByOldState StateNum
sn
                                    DFAStateBuilderContext a -> DFAStateBuilder a ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do DFAStateBuilderContext a
ctx
                                            { $sel:dstBuilderCtxOtherTrans:DStateBuilderContext :: Maybe StateNum
dstBuilderCtxOtherTrans = StateNum -> Maybe StateNum
forall a. a -> Maybe a
Just StateNum
newSn
                                            }

data DFAStateBuilderContext a = DStateBuilderContext
    { DFAStateBuilderContext a -> EnumMap AcceptPriority (Accept a)
dstBuilderCtxAccepts    :: EnumMap.EnumMap Pattern.AcceptPriority (Pattern.Accept a)
    , DFAStateBuilderContext a -> IntMap StateNum
dstBuilderCtxTrans      :: IntMap.IntMap MState.StateNum
    , DFAStateBuilderContext a -> Maybe StateNum
dstBuilderCtxOtherTrans :: Maybe MState.StateNum
    , DFAStateBuilderContext a -> MinDfaContext a
dstBuilderCtxMinDfaCtx  :: MinDfaContext a
    }
    deriving (DFAStateBuilderContext a -> DFAStateBuilderContext a -> Bool
(DFAStateBuilderContext a -> DFAStateBuilderContext a -> Bool)
-> (DFAStateBuilderContext a -> DFAStateBuilderContext a -> Bool)
-> Eq (DFAStateBuilderContext a)
forall a.
Eq a =>
DFAStateBuilderContext a -> DFAStateBuilderContext a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DFAStateBuilderContext a -> DFAStateBuilderContext a -> Bool
$c/= :: forall a.
Eq a =>
DFAStateBuilderContext a -> DFAStateBuilderContext a -> Bool
== :: DFAStateBuilderContext a -> DFAStateBuilderContext a -> Bool
$c== :: forall a.
Eq a =>
DFAStateBuilderContext a -> DFAStateBuilderContext a -> Bool
Eq, Int -> DFAStateBuilderContext a -> ShowS
[DFAStateBuilderContext a] -> ShowS
DFAStateBuilderContext a -> String
(Int -> DFAStateBuilderContext a -> ShowS)
-> (DFAStateBuilderContext a -> String)
-> ([DFAStateBuilderContext a] -> ShowS)
-> Show (DFAStateBuilderContext a)
forall a. Show a => Int -> DFAStateBuilderContext a -> ShowS
forall a. Show a => [DFAStateBuilderContext a] -> ShowS
forall a. Show a => DFAStateBuilderContext a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DFAStateBuilderContext a] -> ShowS
$cshowList :: forall a. Show a => [DFAStateBuilderContext a] -> ShowS
show :: DFAStateBuilderContext a -> String
$cshow :: forall a. Show a => DFAStateBuilderContext a -> String
showsPrec :: Int -> DFAStateBuilderContext a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> DFAStateBuilderContext a -> ShowS
Show, a -> DFAStateBuilderContext b -> DFAStateBuilderContext a
(a -> b) -> DFAStateBuilderContext a -> DFAStateBuilderContext b
(forall a b.
 (a -> b) -> DFAStateBuilderContext a -> DFAStateBuilderContext b)
-> (forall a b.
    a -> DFAStateBuilderContext b -> DFAStateBuilderContext a)
-> Functor DFAStateBuilderContext
forall a b.
a -> DFAStateBuilderContext b -> DFAStateBuilderContext a
forall a b.
(a -> b) -> DFAStateBuilderContext a -> DFAStateBuilderContext b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DFAStateBuilderContext b -> DFAStateBuilderContext a
$c<$ :: forall a b.
a -> DFAStateBuilderContext b -> DFAStateBuilderContext a
fmap :: (a -> b) -> DFAStateBuilderContext a -> DFAStateBuilderContext b
$cfmap :: forall a b.
(a -> b) -> DFAStateBuilderContext a -> DFAStateBuilderContext b
Functor)

type DFAStateBuilder a = State (DFAStateBuilderContext a)

buildDst :: DFAStateBuilder a () -> MinDfaM a (DFA.DFAState a)
buildDst :: DFAStateBuilder a () -> MinDfaM a (DFAState a)
buildDst DFAStateBuilder a ()
builder = do
    MinDfaContext a
minDfaCtx0 <- StateT (MinDfaContext a) Identity (MinDfaContext a)
forall (m :: * -> *) s. Monad m => StateT s m s
get
    let ctx :: DFAStateBuilderContext a
ctx = DFAStateBuilder a ()
-> DFAStateBuilderContext a -> DFAStateBuilderContext a
forall s a. State s a -> s -> s
execState DFAStateBuilder a ()
builder do
            DStateBuilderContext :: forall a.
EnumMap AcceptPriority (Accept a)
-> IntMap StateNum
-> Maybe StateNum
-> MinDfaContext a
-> DFAStateBuilderContext a
DStateBuilderContext
                { $sel:dstBuilderCtxAccepts:DStateBuilderContext :: EnumMap AcceptPriority (Accept a)
dstBuilderCtxAccepts = EnumMap AcceptPriority (Accept a)
forall k a. Enum k => EnumMap k a
EnumMap.empty
                , $sel:dstBuilderCtxTrans:DStateBuilderContext :: IntMap StateNum
dstBuilderCtxTrans = IntMap StateNum
forall a. IntMap a
IntMap.empty
                , $sel:dstBuilderCtxOtherTrans:DStateBuilderContext :: Maybe StateNum
dstBuilderCtxOtherTrans = Maybe StateNum
forall a. Maybe a
Nothing
                , $sel:dstBuilderCtxMinDfaCtx:DStateBuilderContext :: MinDfaContext a
dstBuilderCtxMinDfaCtx = MinDfaContext a
minDfaCtx0
                }
    MinDfaContext a -> StateT (MinDfaContext a) Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do DFAStateBuilderContext a -> MinDfaContext a
forall a. DFAStateBuilderContext a -> MinDfaContext a
dstBuilderCtxMinDfaCtx DFAStateBuilderContext a
ctx
    DFAState a -> MinDfaM a (DFAState a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure DState :: forall a.
[Accept a] -> IntMap StateNum -> Maybe StateNum -> DFAState a
DFA.DState
        { $sel:dstAccepts:DState :: [Accept a]
DFA.dstAccepts = [ Accept a
acc | (AcceptPriority
_, Accept a
acc) <- EnumMap AcceptPriority (Accept a) -> [(AcceptPriority, Accept a)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EnumMap.toDescList do DFAStateBuilderContext a -> EnumMap AcceptPriority (Accept a)
forall a.
DFAStateBuilderContext a -> EnumMap AcceptPriority (Accept a)
dstBuilderCtxAccepts DFAStateBuilderContext a
ctx ]
        , $sel:dstTrans:DState :: IntMap StateNum
DFA.dstTrans   = DFAStateBuilderContext a -> IntMap StateNum
forall a. DFAStateBuilderContext a -> IntMap StateNum
dstBuilderCtxTrans DFAStateBuilderContext a
ctx
        , $sel:dstOtherTrans:DState :: Maybe StateNum
DFA.dstOtherTrans = DFAStateBuilderContext a -> Maybe StateNum
forall a. DFAStateBuilderContext a -> Maybe StateNum
dstBuilderCtxOtherTrans DFAStateBuilderContext a
ctx
        }

liftMinDfaOp :: MinDfaM m a -> DFAStateBuilder m a
liftMinDfaOp :: MinDfaM m a -> DFAStateBuilder m a
liftMinDfaOp MinDfaM m a
builder = do
    DFAStateBuilderContext m
ctx0 <- StateT
  (DFAStateBuilderContext m) Identity (DFAStateBuilderContext m)
forall (m :: * -> *) s. Monad m => StateT s m s
get
    let (a
x, MinDfaContext m
builderCtx1) = MinDfaM m a -> MinDfaContext m -> (a, MinDfaContext m)
forall s a. State s a -> s -> (a, s)
runState MinDfaM m a
builder do DFAStateBuilderContext m -> MinDfaContext m
forall a. DFAStateBuilderContext a -> MinDfaContext a
dstBuilderCtxMinDfaCtx DFAStateBuilderContext m
ctx0
    DFAStateBuilderContext m
-> StateT (DFAStateBuilderContext m) Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do DFAStateBuilderContext m
ctx0
            { $sel:dstBuilderCtxMinDfaCtx:DStateBuilderContext :: MinDfaContext m
dstBuilderCtxMinDfaCtx = MinDfaContext m
builderCtx1
            }
    a -> DFAStateBuilder m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

insertAcceptToDst :: Pattern.Accept a -> DFAStateBuilder a ()
insertAcceptToDst :: Accept a -> DFAStateBuilder a ()
insertAcceptToDst Accept a
acc = (DFAStateBuilderContext a -> DFAStateBuilderContext a)
-> DFAStateBuilder a ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \DFAStateBuilderContext a
builder -> DFAStateBuilderContext a
builder
    { $sel:dstBuilderCtxAccepts:DStateBuilderContext :: EnumMap AcceptPriority (Accept a)
dstBuilderCtxAccepts = AcceptPriority
-> Accept a
-> EnumMap AcceptPriority (Accept a)
-> EnumMap AcceptPriority (Accept a)
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EnumMap.insert
        do Accept a -> AcceptPriority
forall a. Accept a -> AcceptPriority
Pattern.accPriority Accept a
acc
        do Accept a
acc
        do DFAStateBuilderContext a -> EnumMap AcceptPriority (Accept a)
forall a.
DFAStateBuilderContext a -> EnumMap AcceptPriority (Accept a)
dstBuilderCtxAccepts DFAStateBuilderContext a
builder
    }


data Partition = Partition
    { Partition -> StateMap StateNum
partitionMap    :: MState.StateMap MState.StateNum
    , Partition -> StateMap StateSet
partitionMember :: MState.StateMap MState.StateSet
    }
    deriving (Partition -> Partition -> Bool
(Partition -> Partition -> Bool)
-> (Partition -> Partition -> Bool) -> Eq Partition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Partition -> Partition -> Bool
$c/= :: Partition -> Partition -> Bool
== :: Partition -> Partition -> Bool
$c== :: Partition -> Partition -> Bool
Eq, Int -> Partition -> ShowS
[Partition] -> ShowS
Partition -> String
(Int -> Partition -> ShowS)
-> (Partition -> String)
-> ([Partition] -> ShowS)
-> Show Partition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Partition] -> ShowS
$cshowList :: [Partition] -> ShowS
show :: Partition -> String
$cshow :: Partition -> String
showsPrec :: Int -> Partition -> ShowS
$cshowsPrec :: Int -> Partition -> ShowS
Show)

emptyPartition :: Partition
emptyPartition :: Partition
emptyPartition = Partition :: StateMap StateNum -> StateMap StateSet -> Partition
Partition
    { $sel:partitionMap:Partition :: StateMap StateNum
partitionMap = StateMap StateNum
forall a. StateMap a
MState.emptyMap
    , $sel:partitionMember:Partition :: StateMap StateSet
partitionMember = StateMap StateSet
forall a. StateMap a
MState.emptyMap
    }

insertToPartition :: MState.StateSet -> Partition -> Partition
insertToPartition :: StateSet -> Partition -> Partition
insertToPartition StateSet
ss Partition
p0 = case StateSet -> [StateNum]
MState.setToList StateSet
ss of
    []   -> Partition
p0
    StateNum
s0:[StateNum]
_ -> Partition :: StateMap StateNum -> StateMap StateSet -> Partition
Partition
        { $sel:partitionMap:Partition :: StateMap StateNum
partitionMap = (StateMap StateNum -> StateNum -> StateMap StateNum)
-> StateMap StateNum -> [StateNum] -> StateMap StateNum
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            do \StateMap StateNum
m StateNum
s -> StateNum -> StateNum -> StateMap StateNum -> StateMap StateNum
forall a. StateNum -> a -> StateMap a -> StateMap a
MState.insertMap StateNum
s StateNum
s0 StateMap StateNum
m
            do Partition -> StateMap StateNum
partitionMap Partition
p0
            do StateSet -> [StateNum]
MState.setToList StateSet
ss
        , $sel:partitionMember:Partition :: StateMap StateSet
partitionMember = StateNum -> StateSet -> StateMap StateSet -> StateMap StateSet
forall a. StateNum -> a -> StateMap a -> StateMap a
MState.insertMap StateNum
s0 StateSet
ss
            do Partition -> StateMap StateSet
partitionMember Partition
p0
        }

buildPartition :: DFA.DFA a -> Partition
buildPartition :: DFA a -> Partition
buildPartition DFA a
dfa =
    let (Partition
p0, HashSet StateSet
q0) = ((Partition, HashSet StateSet)
 -> (Maybe AcceptPriority, StateSet)
 -> (Partition, HashSet StateSet))
-> (Partition, HashSet StateSet)
-> [(Maybe AcceptPriority, StateSet)]
-> (Partition, HashSet StateSet)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            do \(Partition
p, HashSet StateSet
q) (Maybe AcceptPriority
k, StateSet
ss) ->
                ( StateSet -> Partition -> Partition
insertToPartition StateSet
ss Partition
p
                , case Maybe AcceptPriority
k of
                    Maybe AcceptPriority
Nothing -> HashSet StateSet
q
                    Just{}  -> StateSet -> HashSet StateSet -> HashSet StateSet
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert StateSet
ss HashSet StateSet
q
                )
            do (Partition
emptyPartition, HashSet StateSet
forall a. HashSet a
HashSet.empty)
            do HashMap (Maybe AcceptPriority) StateSet
-> [(Maybe AcceptPriority, StateSet)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList do DFA a -> HashMap (Maybe AcceptPriority) StateSet
forall a. DFA a -> HashMap (Maybe AcceptPriority) StateSet
acceptGroup DFA a
dfa
    in Partition -> HashSet StateSet -> Partition
go Partition
p0 HashSet StateSet
q0
    where
        go :: Partition -> HashSet StateSet -> Partition
go Partition
p0 HashSet StateSet
q0 = case HashSet StateSet -> [StateSet]
forall a. HashSet a -> [a]
HashSet.toList HashSet StateSet
q0 of
            []  -> Partition
p0
            StateSet
a:[StateSet]
_ ->
                let (Partition
p1, HashSet StateSet
q1) = StateSet
-> Partition -> HashSet StateSet -> (Partition, HashSet StateSet)
go2 StateSet
a Partition
p0 do
                        StateSet -> HashSet StateSet -> HashSet StateSet
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.delete StateSet
a HashSet StateSet
q0
                in Partition -> HashSet StateSet -> Partition
go Partition
p1 HashSet StateSet
q1

        go2 :: StateSet
-> Partition -> HashSet StateSet -> (Partition, HashSet StateSet)
go2 StateSet
a Partition
p0 HashSet StateSet
q0 = ((Partition, HashSet StateSet)
 -> StateSet -> (Partition, HashSet StateSet))
-> (Partition, HashSet StateSet)
-> [StateSet]
-> (Partition, HashSet StateSet)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            do \(Partition
p, HashSet StateSet
q) StateSet
x -> Partition
-> HashSet StateSet -> StateSet -> (Partition, HashSet StateSet)
go3 Partition
p HashSet StateSet
q StateSet
x
            do (Partition
p0, HashSet StateSet
q0)
            let rt :: DFARevTrans Any
rt = StateSet -> DFARevTrans Any
findIncomingTrans StateSet
a
            in HashSet StateSet -> [StateSet]
forall a. HashSet a -> [a]
HashSet.toList do
                [StateSet] -> HashSet StateSet
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList
                    [ StateSet
x
                    | StateSet
x <- DFARevTrans Any -> StateSet
forall k (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther DFARevTrans Any
rtStateSet -> [StateSet] -> [StateSet]
forall a. a -> [a] -> [a]
:
                        [ StateSet
x | (Int
_, StateSet
x) <- IntMap StateSet -> [(Int, StateSet)]
forall a. IntMap a -> [(Int, a)]
IntMap.assocs do DFARevTrans Any -> IntMap StateSet
forall k (a :: k). DFARevTrans a -> IntMap StateSet
dfaRevTrans DFARevTrans Any
rt ]
                    , Bool -> Bool
not do StateSet -> Bool
MState.nullSet StateSet
x
                    ]

        go3 :: Partition
-> HashSet StateSet -> StateSet -> (Partition, HashSet StateSet)
go3 Partition
p0 HashSet StateSet
q0 StateSet
x = ((Partition, HashSet StateSet)
 -> (StateNum, StateSet) -> (Partition, HashSet StateSet))
-> (Partition, HashSet StateSet)
-> [(StateNum, StateSet)]
-> (Partition, HashSet StateSet)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            do \(Partition
p, HashSet StateSet
q) (StateNum
sp, StateSet
xy) ->
                let y :: StateSet
y = case StateNum -> StateMap StateSet -> Maybe StateSet
forall a. StateNum -> StateMap a -> Maybe a
MState.lookupMap StateNum
sp do Partition -> StateMap StateSet
partitionMember Partition
p0 of
                        Maybe StateSet
Nothing -> String -> StateSet
forall a. HasCallStack => String -> a
error String
"unreachable"
                        Just StateSet
ss -> StateSet
ss
                    lengthY :: Int
lengthY = StateSet -> Int
MState.lengthSet StateSet
y
                    lengthXY :: Int
lengthXY = StateSet -> Int
MState.lengthSet StateSet
xy
                in if
                    | Int
lengthY Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lengthXY ->
                        (Partition
p, HashSet StateSet
q)
                    | Bool
otherwise ->
                        let diffYX :: StateSet
diffYX = StateSet -> StateSet -> StateSet
MState.diffSet StateSet
y StateSet
xy
                            splitY :: StateSet -> StateSet -> Partition
splitY StateSet
s1 StateSet
s2 = case StateSet -> [StateNum]
MState.setToList StateSet
s2 of
                                []    -> String -> Partition
forall a. HasCallStack => String -> a
error String
"unreachable"
                                StateNum
sp2:[StateNum]
_ -> Partition :: StateMap StateNum -> StateMap StateSet -> Partition
Partition
                                    { $sel:partitionMap:Partition :: StateMap StateNum
partitionMap = (StateMap StateNum -> StateNum -> StateMap StateNum)
-> StateMap StateNum -> [StateNum] -> StateMap StateNum
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
                                        do \StateMap StateNum
m StateNum
s -> StateNum -> StateNum -> StateMap StateNum -> StateMap StateNum
forall a. StateNum -> a -> StateMap a -> StateMap a
MState.insertMap StateNum
s StateNum
sp2 StateMap StateNum
m
                                        do Partition -> StateMap StateNum
partitionMap Partition
p
                                        do StateSet -> [StateNum]
MState.setToList StateSet
s2
                                    , $sel:partitionMember:Partition :: StateMap StateSet
partitionMember = Partition -> StateMap StateSet
partitionMember Partition
p
                                        StateMap StateSet
-> (StateMap StateSet -> StateMap StateSet) -> StateMap StateSet
forall a b. a -> (a -> b) -> b
& StateNum -> StateSet -> StateMap StateSet -> StateMap StateSet
forall a. StateNum -> a -> StateMap a -> StateMap a
MState.insertMap StateNum
sp StateSet
s1
                                        StateMap StateSet
-> (StateMap StateSet -> StateMap StateSet) -> StateMap StateSet
forall a b. a -> (a -> b) -> b
& StateNum -> StateSet -> StateMap StateSet -> StateMap StateSet
forall a. StateNum -> a -> StateMap a -> StateMap a
MState.insertMap StateNum
sp2 StateSet
s2
                                    }
                            p' :: Partition
p' = case StateNum -> StateSet -> Bool
MState.memberSet StateNum
sp StateSet
xy of
                                Bool
True  -> StateSet -> StateSet -> Partition
splitY StateSet
xy StateSet
diffYX
                                Bool
False -> StateSet -> StateSet -> Partition
splitY StateSet
diffYX StateSet
xy
                            q' :: HashSet StateSet
q' = case StateSet -> HashSet StateSet -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member StateSet
y HashSet StateSet
q of
                                Bool
True -> StateSet -> HashSet StateSet -> HashSet StateSet
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.delete StateSet
y HashSet StateSet
q
                                    HashSet StateSet
-> (HashSet StateSet -> HashSet StateSet) -> HashSet StateSet
forall a b. a -> (a -> b) -> b
& StateSet -> HashSet StateSet -> HashSet StateSet
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert StateSet
xy
                                    HashSet StateSet
-> (HashSet StateSet -> HashSet StateSet) -> HashSet StateSet
forall a b. a -> (a -> b) -> b
& StateSet -> HashSet StateSet -> HashSet StateSet
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert StateSet
diffYX
                                Bool
False ->
                                    let y' :: StateSet
y' = case Int
lengthXY Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
lengthY Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 of
                                            Bool
True  -> StateSet
xy
                                            Bool
False -> StateSet
diffYX
                                    in StateSet -> HashSet StateSet -> HashSet StateSet
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert StateSet
y' HashSet StateSet
q
                        in (Partition
p', HashSet StateSet
q')
            do (Partition
p0, HashSet StateSet
q0)
            do StateMap StateSet -> [(StateNum, StateSet)]
forall a. StateMap a -> [(StateNum, a)]
MState.assocsMap do Partition -> StateSet -> StateMap StateSet
findY Partition
p0 StateSet
x

        findY :: Partition -> StateSet -> StateMap StateSet
findY Partition{ StateMap StateNum
partitionMap :: StateMap StateNum
$sel:partitionMap:Partition :: Partition -> StateMap StateNum
partitionMap } StateSet
x = (StateMap StateSet -> StateNum -> StateMap StateSet)
-> StateMap StateSet -> [StateNum] -> StateMap StateSet
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            do \StateMap StateSet
ym StateNum
s -> case StateNum -> StateMap StateNum -> Maybe StateNum
forall a. StateNum -> StateMap a -> Maybe a
MState.lookupMap StateNum
s StateMap StateNum
partitionMap of
                Maybe StateNum
Nothing -> String -> StateMap StateSet
forall a. HasCallStack => String -> a
error String
"unreachable"
                Just StateNum
sp -> StateNum
-> StateSet
-> (StateSet -> StateSet)
-> StateMap StateSet
-> StateMap StateSet
forall a. StateNum -> a -> (a -> a) -> StateMap a -> StateMap a
MState.insertOrUpdateMap StateNum
sp
                    do StateNum -> StateSet
MState.singletonSet StateNum
s
                    do \StateSet
ss -> StateNum -> StateSet -> StateSet
MState.insertSet StateNum
s StateSet
ss
                    do StateMap StateSet
ym
            do StateMap StateSet
forall a. StateMap a
MState.emptyMap
            do StateSet -> [StateNum]
MState.setToList StateSet
x

        findIncomingTrans :: StateSet -> DFARevTrans Any
findIncomingTrans StateSet
ss = (DFARevTrans Any -> StateNum -> DFARevTrans Any)
-> DFARevTrans Any -> [StateNum] -> DFARevTrans Any
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            do \DFARevTrans Any
rt0 StateNum
s -> case StateNum -> StateMap (DFARevTrans a) -> Maybe (DFARevTrans a)
forall a. StateNum -> StateMap a -> Maybe a
MState.lookupMap StateNum
s StateMap (DFARevTrans a)
rtrans of
                Maybe (DFARevTrans a)
Nothing -> DFARevTrans Any
rt0
                Just DFARevTrans a
rt -> DFARevTrans :: forall k (a :: k). IntMap StateSet -> StateSet -> DFARevTrans a
DFARevTrans
                    { $sel:dfaRevTrans:DFARevTrans :: IntMap StateSet
dfaRevTrans = (Int -> StateSet -> StateSet -> Maybe StateSet)
-> (IntMap StateSet -> IntMap StateSet)
-> (IntMap StateSet -> IntMap StateSet)
-> IntMap StateSet
-> IntMap StateSet
-> IntMap StateSet
forall a b c.
(Int -> a -> b -> Maybe c)
-> (IntMap a -> IntMap c)
-> (IntMap b -> IntMap c)
-> IntMap a
-> IntMap b
-> IntMap c
IntMap.mergeWithKey
                        do \Int
_ StateSet
ss1 StateSet
ss2 -> StateSet -> Maybe StateSet
forall a. a -> Maybe a
Just do StateSet -> StateSet -> StateSet
MState.unionSet StateSet
ss1 StateSet
ss2
                        do \IntMap StateSet
t1 -> IntMap StateSet
t1 IntMap StateSet -> (StateSet -> StateSet) -> IntMap StateSet
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \StateSet
ss1 -> StateSet -> StateSet -> StateSet
MState.unionSet StateSet
ss1
                            do DFARevTrans a -> StateSet
forall k (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther DFARevTrans a
rt
                        do \IntMap StateSet
t2 -> IntMap StateSet
t2 IntMap StateSet -> (StateSet -> StateSet) -> IntMap StateSet
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \StateSet
ss2 -> StateSet -> StateSet -> StateSet
MState.unionSet StateSet
ss2
                            do DFARevTrans Any -> StateSet
forall k (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther DFARevTrans Any
rt0
                        do DFARevTrans Any -> IntMap StateSet
forall k (a :: k). DFARevTrans a -> IntMap StateSet
dfaRevTrans DFARevTrans Any
rt0
                        do DFARevTrans a -> IntMap StateSet
forall k (a :: k). DFARevTrans a -> IntMap StateSet
dfaRevTrans DFARevTrans a
rt
                    , $sel:dfaRevTransOther:DFARevTrans :: StateSet
dfaRevTransOther = StateSet -> StateSet -> StateSet
MState.unionSet
                        do DFARevTrans Any -> StateSet
forall k (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther DFARevTrans Any
rt0
                        do DFARevTrans a -> StateSet
forall k (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther DFARevTrans a
rt
                    }
            do DFARevTrans :: forall k (a :: k). IntMap StateSet -> StateSet -> DFARevTrans a
DFARevTrans
                { $sel:dfaRevTrans:DFARevTrans :: IntMap StateSet
dfaRevTrans = IntMap StateSet
forall a. IntMap a
IntMap.empty
                , $sel:dfaRevTransOther:DFARevTrans :: StateSet
dfaRevTransOther = StateSet
MState.emptySet
                }
            do StateSet -> [StateNum]
MState.setToList StateSet
ss

        rtrans :: StateMap (DFARevTrans a)
rtrans = DFA a -> StateMap (DFARevTrans a)
forall a. DFA a -> StateMap (DFARevTrans a)
revTrans DFA a
dfa

acceptGroup :: DFA.DFA a -> HashMap.HashMap (Maybe Pattern.AcceptPriority) MState.StateSet
acceptGroup :: DFA a -> HashMap (Maybe AcceptPriority) StateSet
acceptGroup DFA.DFA{ StateArray (DFAState a)
dfaTrans :: StateArray (DFAState a)
$sel:dfaTrans:DFA :: forall a. DFA a -> StateArray (DFAState a)
dfaTrans } = (HashMap (Maybe AcceptPriority) StateSet
 -> (StateNum, DFAState a)
 -> HashMap (Maybe AcceptPriority) StateSet)
-> HashMap (Maybe AcceptPriority) StateSet
-> [(StateNum, DFAState a)]
-> HashMap (Maybe AcceptPriority) StateSet
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
    do \HashMap (Maybe AcceptPriority) StateSet
m (StateNum
s, DFAState a
dst) -> case DFAState a -> [Accept a]
forall a. DFAState a -> [Accept a]
DFA.dstAccepts DFAState a
dst of
        []    -> Maybe AcceptPriority
-> StateNum
-> HashMap (Maybe AcceptPriority) StateSet
-> HashMap (Maybe AcceptPriority) StateSet
forall k.
(Eq k, Hashable k) =>
k -> StateNum -> HashMap k StateSet -> HashMap k StateSet
insertState Maybe AcceptPriority
forall a. Maybe a
Nothing StateNum
s HashMap (Maybe AcceptPriority) StateSet
m
        Accept a
acc:[Accept a]
_ -> Maybe AcceptPriority
-> StateNum
-> HashMap (Maybe AcceptPriority) StateSet
-> HashMap (Maybe AcceptPriority) StateSet
forall k.
(Eq k, Hashable k) =>
k -> StateNum -> HashMap k StateSet -> HashMap k StateSet
insertState
            do AcceptPriority -> Maybe AcceptPriority
forall a. a -> Maybe a
Just do Accept a -> AcceptPriority
forall a. Accept a -> AcceptPriority
Pattern.accPriority Accept a
acc
            do StateNum
s
            do HashMap (Maybe AcceptPriority) StateSet
m
    do HashMap (Maybe AcceptPriority) StateSet
forall k v. HashMap k v
HashMap.empty
    do StateArray (DFAState a) -> [(StateNum, DFAState a)]
forall a. StateArray a -> [(StateNum, a)]
MState.arrayAssocs StateArray (DFAState a)
dfaTrans
    where
        insertState :: k -> StateNum -> HashMap k StateSet -> HashMap k StateSet
insertState k
k StateNum
s HashMap k StateSet
m = case k -> HashMap k StateSet -> Maybe StateSet
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup k
k HashMap k StateSet
m of
            Maybe StateSet
Nothing -> k -> StateSet -> HashMap k StateSet -> HashMap k StateSet
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert k
k
                do StateNum -> StateSet
MState.singletonSet StateNum
s
                do HashMap k StateSet
m
            Just StateSet
ss -> k -> StateSet -> HashMap k StateSet -> HashMap k StateSet
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert k
k
                do StateNum -> StateSet -> StateSet
MState.insertSet StateNum
s StateSet
ss
                do HashMap k StateSet
m


data DFARevTrans a = DFARevTrans
    { DFARevTrans a -> IntMap StateSet
dfaRevTrans      :: IntMap.IntMap MState.StateSet
    , DFARevTrans a -> StateSet
dfaRevTransOther :: MState.StateSet
    }

revTrans :: DFA.DFA a -> MState.StateMap (DFARevTrans a)
revTrans :: DFA a -> StateMap (DFARevTrans a)
revTrans DFA.DFA{ StateArray (DFAState a)
dfaTrans :: StateArray (DFAState a)
$sel:dfaTrans:DFA :: forall a. DFA a -> StateArray (DFAState a)
dfaTrans } = (StateMap (DFARevTrans a)
 -> (StateNum, DFAState a) -> StateMap (DFARevTrans a))
-> StateMap (DFARevTrans a)
-> [(StateNum, DFAState a)]
-> StateMap (DFARevTrans a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
    do \StateMap (DFARevTrans a)
m0 (StateNum
sf, DFAState a
dst) ->
        let trans :: IntMap StateNum
trans = DFAState a -> IntMap StateNum
forall a. DFAState a -> IntMap StateNum
DFA.dstTrans DFAState a
dst
            m1 :: StateMap (DFARevTrans a)
m1 = (StateMap (DFARevTrans a)
 -> (Int, StateNum) -> StateMap (DFARevTrans a))
-> StateMap (DFARevTrans a)
-> [(Int, StateNum)]
-> StateMap (DFARevTrans a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
                do \StateMap (DFARevTrans a)
m (Int
c, StateNum
st) -> StateNum
-> Int
-> StateNum
-> StateMap (DFARevTrans a)
-> StateMap (DFARevTrans a)
forall k (a :: k).
StateNum
-> Int
-> StateNum
-> StateMap (DFARevTrans a)
-> StateMap (DFARevTrans a)
insertTrans StateNum
sf Int
c StateNum
st StateMap (DFARevTrans a)
m
                do StateMap (DFARevTrans a)
m0
                do IntMap StateNum -> [(Int, StateNum)]
forall a. IntMap a -> [(Int, a)]
IntMap.assocs IntMap StateNum
trans
        in case DFAState a -> Maybe StateNum
forall a. DFAState a -> Maybe StateNum
DFA.dstOtherTrans DFAState a
dst of
            Maybe StateNum
Nothing -> StateMap (DFARevTrans a)
m1
            Just StateNum
st -> StateNum
-> StateNum
-> IntMap StateNum
-> StateMap (DFARevTrans a)
-> StateMap (DFARevTrans a)
forall k a (a :: k).
StateNum
-> StateNum
-> IntMap a
-> StateMap (DFARevTrans a)
-> StateMap (DFARevTrans a)
insertOtherTrans StateNum
sf StateNum
st IntMap StateNum
trans StateMap (DFARevTrans a)
m1
    do StateMap (DFARevTrans a)
forall a. StateMap a
MState.emptyMap
    do StateArray (DFAState a) -> [(StateNum, DFAState a)]
forall a. StateArray a -> [(StateNum, a)]
MState.arrayAssocs StateArray (DFAState a)
dfaTrans
    where
        insertTrans :: StateNum
-> Int
-> StateNum
-> StateMap (DFARevTrans a)
-> StateMap (DFARevTrans a)
insertTrans StateNum
sf Int
c StateNum
st StateMap (DFARevTrans a)
m0 = StateNum
-> DFARevTrans a
-> (DFARevTrans a -> DFARevTrans a)
-> StateMap (DFARevTrans a)
-> StateMap (DFARevTrans a)
forall a. StateNum -> a -> (a -> a) -> StateMap a -> StateMap a
MState.insertOrUpdateMap StateNum
st
            do DFARevTrans :: forall k (a :: k). IntMap StateSet -> StateSet -> DFARevTrans a
DFARevTrans
                { $sel:dfaRevTrans:DFARevTrans :: IntMap StateSet
dfaRevTrans = Int -> StateSet -> IntMap StateSet
forall a. Int -> a -> IntMap a
IntMap.singleton Int
c do StateNum -> StateSet
MState.singletonSet StateNum
sf
                , $sel:dfaRevTransOther:DFARevTrans :: StateSet
dfaRevTransOther = StateSet
MState.emptySet
                }
            do \DFARevTrans a
rtrans ->
                let rtransRevTrans :: IntMap StateSet
rtransRevTrans = DFARevTrans a -> IntMap StateSet
forall k (a :: k). DFARevTrans a -> IntMap StateSet
dfaRevTrans DFARevTrans a
rtrans
                in DFARevTrans a
rtrans
                    { $sel:dfaRevTrans:DFARevTrans :: IntMap StateSet
dfaRevTrans = case Int -> IntMap StateSet -> Maybe StateSet
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
c IntMap StateSet
rtransRevTrans of
                        Maybe StateSet
Nothing -> Int -> StateSet -> IntMap StateSet -> IntMap StateSet
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
c
                            do StateNum -> StateSet -> StateSet
MState.insertSet StateNum
sf do DFARevTrans a -> StateSet
forall k (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther DFARevTrans a
rtrans
                            do IntMap StateSet
rtransRevTrans
                        Just StateSet
ss -> Int -> StateSet -> IntMap StateSet -> IntMap StateSet
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
c
                            do StateNum -> StateSet -> StateSet
MState.insertSet StateNum
sf StateSet
ss
                            do IntMap StateSet
rtransRevTrans
                    }
            do StateMap (DFARevTrans a)
m0

        insertOtherTrans :: StateNum
-> StateNum
-> IntMap a
-> StateMap (DFARevTrans a)
-> StateMap (DFARevTrans a)
insertOtherTrans StateNum
sf StateNum
st IntMap a
trans StateMap (DFARevTrans a)
m0 = StateNum
-> DFARevTrans a
-> (DFARevTrans a -> DFARevTrans a)
-> StateMap (DFARevTrans a)
-> StateMap (DFARevTrans a)
forall a. StateNum -> a -> (a -> a) -> StateMap a -> StateMap a
MState.insertOrUpdateMap StateNum
st
            do DFARevTrans :: forall k (a :: k). IntMap StateSet -> StateSet -> DFARevTrans a
DFARevTrans
                { $sel:dfaRevTrans:DFARevTrans :: IntMap StateSet
dfaRevTrans = IntMap a
trans IntMap a -> (a -> StateSet) -> IntMap StateSet
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
_ -> StateSet
MState.emptySet
                , $sel:dfaRevTransOther:DFARevTrans :: StateSet
dfaRevTransOther = StateNum -> StateSet
MState.singletonSet StateNum
sf
                }
            do \DFARevTrans a
rtrans -> DFARevTrans :: forall k (a :: k). IntMap StateSet -> StateSet -> DFARevTrans a
DFARevTrans
                { $sel:dfaRevTrans:DFARevTrans :: IntMap StateSet
dfaRevTrans = (Int -> StateSet -> a -> Maybe StateSet)
-> (IntMap StateSet -> IntMap StateSet)
-> (IntMap a -> IntMap StateSet)
-> IntMap StateSet
-> IntMap a
-> IntMap StateSet
forall a b c.
(Int -> a -> b -> Maybe c)
-> (IntMap a -> IntMap c)
-> (IntMap b -> IntMap c)
-> IntMap a
-> IntMap b
-> IntMap c
IntMap.mergeWithKey
                    do \Int
_ StateSet
ss a
_ -> StateSet -> Maybe StateSet
forall a. a -> Maybe a
Just StateSet
ss
                    do \IntMap StateSet
rt -> IntMap StateSet
rt IntMap StateSet -> (StateSet -> StateSet) -> IntMap StateSet
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \StateSet
ss -> StateNum -> StateSet -> StateSet
MState.insertSet StateNum
sf StateSet
ss
                    do \IntMap a
t -> IntMap a
t IntMap a -> (a -> StateSet) -> IntMap StateSet
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
_ -> DFARevTrans a -> StateSet
forall k (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther DFARevTrans a
rtrans
                    do DFARevTrans a -> IntMap StateSet
forall k (a :: k). DFARevTrans a -> IntMap StateSet
dfaRevTrans DFARevTrans a
rtrans
                    do IntMap a
trans
                , $sel:dfaRevTransOther:DFARevTrans :: StateSet
dfaRevTransOther = StateNum -> StateSet -> StateSet
MState.insertSet StateNum
sf
                    do DFARevTrans a -> StateSet
forall k (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther DFARevTrans a
rtrans
                }
            do StateMap (DFARevTrans a)
m0