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

import           Language.Lexer.Tlex.Prelude

import qualified Data.EnumMap.Strict                 as EnumMap
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.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 :: forall a. DFA a -> DFA a
minDfa DFA a
dfa = forall m. DFABuilder m () -> DFA m
DFA.buildDFA
    do forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \DFABuilderContext a
dfaBuilderCtx0 -> forall m. MinDfaContext m -> DFABuilderContext m
minDfaCtxDFABuilderCtx
        do forall s a. State s a -> s -> s
execState
            do forall a. DFA a -> MinDfaM a ()
minDfaM DFA a
dfa
            do MinDfaContext
                { $sel:minDfaCtxStateMap:MinDfaContext :: StateMap StateNum
minDfaCtxStateMap = forall a. StateMap a
MState.emptyMap
                , $sel:minDfaCtxDFABuilderCtx:MinDfaContext :: DFABuilderContext a
minDfaCtxDFABuilderCtx = DFABuilderContext a
dfaBuilderCtx0
                }


data MinDfaContext m = MinDfaContext
    { forall m. MinDfaContext m -> StateMap StateNum
minDfaCtxStateMap      :: MState.StateMap MState.StateNum
    , forall m. MinDfaContext m -> DFABuilderContext m
minDfaCtxDFABuilderCtx :: DFA.DFABuilderContext m
    }
    deriving (MinDfaContext m -> MinDfaContext m -> Bool
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
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, 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
<$ :: forall a b. a -> MinDfaContext b -> MinDfaContext a
$c<$ :: forall a b. a -> MinDfaContext b -> MinDfaContext a
fmap :: forall a b. (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 :: forall m a. DFABuilder m a -> MinDfaM m a
liftBuilderOp DFABuilder m a
builder = do
    MinDfaContext m
ctx0 <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    let (a
x, DFABuilderContext m
builderCtx1) = forall s a. State s a -> s -> (a, s)
runState DFABuilder m a
builder do forall m. MinDfaContext m -> DFABuilderContext m
minDfaCtxDFABuilderCtx MinDfaContext m
ctx0
    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do MinDfaContext m
ctx0
            { $sel:minDfaCtxDFABuilderCtx:MinDfaContext :: DFABuilderContext m
minDfaCtxDFABuilderCtx = DFABuilderContext m
builderCtx1
            }
    forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

registerNewState :: MState.StateNum -> MinDfaM m MState.StateNum
registerNewState :: forall m. StateNum -> MinDfaM m StateNum
registerNewState StateNum
r = do
    StateNum
sn <- forall m a. DFABuilder m a -> MinDfaM m a
liftBuilderOp forall m. DFABuilder m StateNum
DFA.newStateNum
    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 = forall a. StateNum -> a -> StateMap a -> StateMap a
MState.insertMap StateNum
r StateNum
sn StateMap StateNum
minDfaCtxStateMap
        }
    forall (f :: * -> *) a. Applicative f => a -> f a
pure StateNum
sn

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

minDfaM :: DFA.DFA a -> MinDfaM a ()
minDfaM :: forall a. 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
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
        do forall k a. Enum k => EnumMap k a -> [(k, a)]
EnumMap.assocs do 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
            forall m a. DFABuilder m a -> MinDfaM m a
liftBuilderOp do forall m. StateNum -> StartState -> DFABuilder m ()
DFA.initial StateNum
newSn StartState
startS

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

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

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

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

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

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

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

insertAcceptToDst :: Pattern.Accept a -> DFAStateBuilder a ()
insertAcceptToDst :: forall a. Accept a -> DFAStateBuilder a ()
insertAcceptToDst Accept a
acc = 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 = forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EnumMap.insert
        do forall a. Accept a -> AcceptPriority
Pattern.accPriority Accept a
acc
        do Accept a
acc
        do 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
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
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
    { $sel:partitionMap:Partition :: StateMap StateNum
partitionMap = forall a. StateMap a
MState.emptyMap
    , $sel:partitionMember:Partition :: StateMap StateSet
partitionMember = 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
        { $sel:partitionMap:Partition :: StateMap StateNum
partitionMap = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            do \StateMap StateNum
m StateNum
s -> 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 = 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 :: forall a. DFA a -> Partition
buildPartition DFA a
dfa =
    let (Partition
p0, HashSet StateSet
q0) = 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{}  -> forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert StateSet
ss HashSet StateSet
q
                )
            do (Partition
emptyPartition, forall a. HashSet a
HashSet.empty)
            do forall k v. HashMap k v -> [(k, v)]
HashMap.toList do 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 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
                        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 = 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 forall a. HashSet a -> [a]
HashSet.toList do
                forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList
                    [ StateSet
x
                    | StateSet
x <- forall {k} (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther DFARevTrans Any
rtforall a. a -> [a] -> [a]
:
                        [ StateSet
x | (Int
_, StateSet
x) <- forall a. IntMap a -> [(Int, a)]
IntMap.assocs do 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 = 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 forall a. StateNum -> StateMap a -> Maybe a
MState.lookupMap StateNum
sp do Partition -> StateMap StateSet
partitionMember Partition
p0 of
                        Maybe StateSet
Nothing -> 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 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
                                []    -> forall a. HasCallStack => String -> a
error String
"unreachable"
                                StateNum
sp2:[StateNum]
_ -> Partition
                                    { $sel:partitionMap:Partition :: StateMap StateNum
partitionMap = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
                                        do \StateMap StateNum
m StateNum
s -> 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
                                        forall a b. a -> (a -> b) -> b
& forall a. StateNum -> a -> StateMap a -> StateMap a
MState.insertMap StateNum
sp StateSet
s1
                                        forall a b. a -> (a -> b) -> b
& 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 forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member StateSet
y HashSet StateSet
q of
                                Bool
True -> forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.delete StateSet
y HashSet StateSet
q
                                    forall a b. a -> (a -> b) -> b
& forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert StateSet
xy
                                    forall a b. a -> (a -> b) -> b
& forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert StateSet
diffYX
                                Bool
False ->
                                    let y' :: StateSet
y' = case Int
lengthXY forall a. Ord a => a -> a -> Bool
<= Int
lengthY forall a. Integral a => a -> a -> a
`div` Int
2 of
                                            Bool
True  -> StateSet
xy
                                            Bool
False -> StateSet
diffYX
                                    in 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 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            do \StateMap StateSet
ym StateNum
s -> case forall a. StateNum -> StateMap a -> Maybe a
MState.lookupMap StateNum
s StateMap StateNum
partitionMap of
                Maybe StateNum
Nothing -> forall a. HasCallStack => String -> a
error String
"unreachable"
                Just StateNum
sp -> 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 forall a. StateMap a
MState.emptyMap
            do StateSet -> [StateNum]
MState.setToList StateSet
x

        findIncomingTrans :: StateSet -> DFARevTrans Any
findIncomingTrans StateSet
ss = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            do \DFARevTrans Any
rt0 StateNum
s -> case 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
                    { $sel:dfaRevTrans:DFARevTrans :: IntMap StateSet
dfaRevTrans = 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 -> forall a. a -> Maybe a
Just do StateSet -> StateSet -> StateSet
MState.unionSet StateSet
ss1 StateSet
ss2
                        do \IntMap StateSet
t1 -> IntMap StateSet
t1 forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \StateSet
ss1 -> StateSet -> StateSet -> StateSet
MState.unionSet StateSet
ss1
                            do forall {k} (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther DFARevTrans a
rt
                        do \IntMap StateSet
t2 -> IntMap StateSet
t2 forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \StateSet
ss2 -> StateSet -> StateSet -> StateSet
MState.unionSet StateSet
ss2
                            do forall {k} (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther DFARevTrans Any
rt0
                        do forall {k} (a :: k). DFARevTrans a -> IntMap StateSet
dfaRevTrans DFARevTrans Any
rt0
                        do forall {k} (a :: k). DFARevTrans a -> IntMap StateSet
dfaRevTrans DFARevTrans a
rt
                    , $sel:dfaRevTransOther:DFARevTrans :: StateSet
dfaRevTransOther = StateSet -> StateSet -> StateSet
MState.unionSet
                        do forall {k} (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther DFARevTrans Any
rt0
                        do forall {k} (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther DFARevTrans a
rt
                    }
            do DFARevTrans
                { $sel:dfaRevTrans:DFARevTrans :: IntMap StateSet
dfaRevTrans = 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 = forall a. DFA a -> StateMap (DFARevTrans a)
revTrans DFA a
dfa

acceptGroup :: DFA.DFA a -> HashMap.HashMap (Maybe Pattern.AcceptPriority) MState.StateSet
acceptGroup :: forall a. 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 } = 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 forall a. DFAState a -> [Accept a]
DFA.dstAccepts DFAState a
dst of
        []    -> forall {k}.
Hashable k =>
k -> StateNum -> HashMap k StateSet -> HashMap k StateSet
insertState forall a. Maybe a
Nothing StateNum
s HashMap (Maybe AcceptPriority) StateSet
m
        Accept a
acc:[Accept a]
_ -> forall {k}.
Hashable k =>
k -> StateNum -> HashMap k StateSet -> HashMap k StateSet
insertState
            do forall a. a -> Maybe a
Just do forall a. Accept a -> AcceptPriority
Pattern.accPriority Accept a
acc
            do StateNum
s
            do HashMap (Maybe AcceptPriority) StateSet
m
    do forall k v. HashMap k v
HashMap.empty
    do 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 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 -> 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 -> 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
    { forall {k} (a :: k). DFARevTrans a -> IntMap StateSet
dfaRevTrans      :: IntMap.IntMap MState.StateSet
    , forall {k} (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther :: MState.StateSet
    }

revTrans :: DFA.DFA a -> MState.StateMap (DFARevTrans a)
revTrans :: forall a. 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 } = 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 = forall a. DFAState a -> IntMap StateNum
DFA.dstTrans DFAState a
dst
            m1 :: StateMap (DFARevTrans a)
m1 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
                do \StateMap (DFARevTrans a)
m (Int
c, StateNum
st) -> 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 forall a. IntMap a -> [(Int, a)]
IntMap.assocs IntMap StateNum
trans
        in case forall a. DFAState a -> Maybe StateNum
DFA.dstOtherTrans DFAState a
dst of
            Maybe StateNum
Nothing -> StateMap (DFARevTrans a)
m1
            Just StateNum
st -> 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 forall a. StateMap a
MState.emptyMap
    do 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 = forall a. StateNum -> a -> (a -> a) -> StateMap a -> StateMap a
MState.insertOrUpdateMap StateNum
st
            do DFARevTrans
                { $sel:dfaRevTrans:DFARevTrans :: IntMap StateSet
dfaRevTrans = 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 = forall {k} (a :: k). DFARevTrans a -> IntMap StateSet
dfaRevTrans DFARevTrans a
rtrans
                in DFARevTrans a
rtrans
                    { $sel:dfaRevTrans:DFARevTrans :: IntMap StateSet
dfaRevTrans = case forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
c IntMap StateSet
rtransRevTrans of
                        Maybe StateSet
Nothing -> forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
c
                            do StateNum -> StateSet -> StateSet
MState.insertSet StateNum
sf do forall {k} (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther DFARevTrans a
rtrans
                            do IntMap StateSet
rtransRevTrans
                        Just StateSet
ss -> 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 = forall a. StateNum -> a -> (a -> a) -> StateMap a -> StateMap a
MState.insertOrUpdateMap StateNum
st
            do DFARevTrans
                { $sel:dfaRevTrans:DFARevTrans :: IntMap StateSet
dfaRevTrans = IntMap a
trans 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
                { $sel:dfaRevTrans:DFARevTrans :: IntMap StateSet
dfaRevTrans = 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
_ -> forall a. a -> Maybe a
Just StateSet
ss
                    do \IntMap StateSet
rt -> IntMap StateSet
rt 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 forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
_ -> forall {k} (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther DFARevTrans a
rtrans
                    do 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 forall {k} (a :: k). DFARevTrans a -> StateSet
dfaRevTransOther DFARevTrans a
rtrans
                }
            do StateMap (DFARevTrans a)
m0