{-# LANGUAGE GADTs #-}
module Text.Regex.Applicative.Compile (compile) where
import Control.Monad ((<=<))
import Control.Monad.Trans.State
import Data.Foldable
import Data.Maybe
import Data.Monoid (Any (..))
import qualified Data.IntMap as IntMap
import Text.Regex.Applicative.Types
compile :: RE s a -> (a -> [Thread s r]) -> [Thread s r]
compile :: forall s a r. RE s a -> (a -> [Thread s r]) -> [Thread s r]
compile RE s a
e a -> [Thread s r]
k = RE s a -> Cont (a -> [Thread s r]) -> [Thread s r]
forall s a r. RE s a -> Cont (a -> [Thread s r]) -> [Thread s r]
compile2 RE s a
e ((a -> [Thread s r]) -> Cont (a -> [Thread s r])
forall a. a -> Cont a
SingleCont a -> [Thread s r]
k)
data Cont a = SingleCont !a | EmptyNonEmpty !a !a
instance Functor Cont where
fmap :: forall a b. (a -> b) -> Cont a -> Cont b
fmap a -> b
f Cont a
k =
case Cont a
k of
SingleCont a
a -> b -> Cont b
forall a. a -> Cont a
SingleCont (a -> b
f a
a)
EmptyNonEmpty a
a a
b -> b -> b -> Cont b
forall a. a -> a -> Cont a
EmptyNonEmpty (a -> b
f a
a) (a -> b
f a
b)
emptyCont :: Cont a -> a
emptyCont :: forall a. Cont a -> a
emptyCont Cont a
k =
case Cont a
k of
SingleCont a
a -> a
a
EmptyNonEmpty a
a a
_ -> a
a
nonEmptyCont :: Cont a -> a
nonEmptyCont :: forall a. Cont a -> a
nonEmptyCont Cont a
k =
case Cont a
k of
SingleCont a
a -> a
a
EmptyNonEmpty a
_ a
a -> a
a
compile2 :: RE s a -> Cont (a -> [Thread s r]) -> [Thread s r]
compile2 :: forall s a r. RE s a -> Cont (a -> [Thread s r]) -> [Thread s r]
compile2 RE s a
e =
case RE s a
e of
RE s a
Eps -> \Cont (a -> [Thread s r])
k -> Cont (a -> [Thread s r]) -> a -> [Thread s r]
forall a. Cont a -> a
emptyCont Cont (a -> [Thread s r])
k ()
Symbol ThreadId
i s -> Maybe a
p -> \Cont (a -> [Thread s r])
k -> [(a -> [Thread s r]) -> Thread s r
t ((a -> [Thread s r]) -> Thread s r)
-> (a -> [Thread s r]) -> Thread s r
forall a b. (a -> b) -> a -> b
$ Cont (a -> [Thread s r]) -> a -> [Thread s r]
forall a. Cont a -> a
nonEmptyCont Cont (a -> [Thread s r])
k] where
t :: (a -> [Thread s r]) -> Thread s r
t a -> [Thread s r]
k = ThreadId -> (s -> [Thread s r]) -> Thread s r
forall s r. ThreadId -> (s -> [Thread s r]) -> Thread s r
Thread ThreadId
i ((s -> [Thread s r]) -> Thread s r)
-> (s -> [Thread s r]) -> Thread s r
forall a b. (a -> b) -> a -> b
$ \s
s ->
case s -> Maybe a
p s
s of
Just a
r -> a -> [Thread s r]
k a
r
Maybe a
Nothing -> []
App RE s (a1 -> a)
n1 RE s a1
n2 ->
let a1 :: Cont ((a1 -> a) -> [Thread s r]) -> [Thread s r]
a1 = RE s (a1 -> a) -> Cont ((a1 -> a) -> [Thread s r]) -> [Thread s r]
forall s a r. RE s a -> Cont (a -> [Thread s r]) -> [Thread s r]
compile2 RE s (a1 -> a)
n1
a2 :: Cont (a1 -> [Thread s r]) -> [Thread s r]
a2 = RE s a1 -> Cont (a1 -> [Thread s r]) -> [Thread s r]
forall s a r. RE s a -> Cont (a -> [Thread s r]) -> [Thread s r]
compile2 RE s a1
n2
in \Cont (a -> [Thread s r])
k -> case Cont (a -> [Thread s r])
k of
SingleCont a -> [Thread s r]
k -> Cont ((a1 -> a) -> [Thread s r]) -> [Thread s r]
a1 (Cont ((a1 -> a) -> [Thread s r]) -> [Thread s r])
-> Cont ((a1 -> a) -> [Thread s r]) -> [Thread s r]
forall a b. (a -> b) -> a -> b
$ ((a1 -> a) -> [Thread s r]) -> Cont ((a1 -> a) -> [Thread s r])
forall a. a -> Cont a
SingleCont (((a1 -> a) -> [Thread s r]) -> Cont ((a1 -> a) -> [Thread s r]))
-> ((a1 -> a) -> [Thread s r]) -> Cont ((a1 -> a) -> [Thread s r])
forall a b. (a -> b) -> a -> b
$ \a1 -> a
a1_value -> Cont (a1 -> [Thread s r]) -> [Thread s r]
a2 (Cont (a1 -> [Thread s r]) -> [Thread s r])
-> Cont (a1 -> [Thread s r]) -> [Thread s r]
forall a b. (a -> b) -> a -> b
$ (a1 -> [Thread s r]) -> Cont (a1 -> [Thread s r])
forall a. a -> Cont a
SingleCont ((a1 -> [Thread s r]) -> Cont (a1 -> [Thread s r]))
-> (a1 -> [Thread s r]) -> Cont (a1 -> [Thread s r])
forall a b. (a -> b) -> a -> b
$ a -> [Thread s r]
k (a -> [Thread s r]) -> (a1 -> a) -> a1 -> [Thread s r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a1 -> a
a1_value
EmptyNonEmpty a -> [Thread s r]
ke a -> [Thread s r]
kn ->
Cont ((a1 -> a) -> [Thread s r]) -> [Thread s r]
a1 (Cont ((a1 -> a) -> [Thread s r]) -> [Thread s r])
-> Cont ((a1 -> a) -> [Thread s r]) -> [Thread s r]
forall a b. (a -> b) -> a -> b
$ ((a1 -> a) -> [Thread s r])
-> ((a1 -> a) -> [Thread s r]) -> Cont ((a1 -> a) -> [Thread s r])
forall a. a -> a -> Cont a
EmptyNonEmpty
(\a1 -> a
a1_value -> Cont (a1 -> [Thread s r]) -> [Thread s r]
a2 (Cont (a1 -> [Thread s r]) -> [Thread s r])
-> Cont (a1 -> [Thread s r]) -> [Thread s r]
forall a b. (a -> b) -> a -> b
$ (a1 -> [Thread s r])
-> (a1 -> [Thread s r]) -> Cont (a1 -> [Thread s r])
forall a. a -> a -> Cont a
EmptyNonEmpty (a -> [Thread s r]
ke (a -> [Thread s r]) -> (a1 -> a) -> a1 -> [Thread s r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a1 -> a
a1_value) (a -> [Thread s r]
kn (a -> [Thread s r]) -> (a1 -> a) -> a1 -> [Thread s r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a1 -> a
a1_value))
(\a1 -> a
a1_value -> Cont (a1 -> [Thread s r]) -> [Thread s r]
a2 (Cont (a1 -> [Thread s r]) -> [Thread s r])
-> Cont (a1 -> [Thread s r]) -> [Thread s r]
forall a b. (a -> b) -> a -> b
$ (a1 -> [Thread s r])
-> (a1 -> [Thread s r]) -> Cont (a1 -> [Thread s r])
forall a. a -> a -> Cont a
EmptyNonEmpty (a -> [Thread s r]
kn (a -> [Thread s r]) -> (a1 -> a) -> a1 -> [Thread s r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a1 -> a
a1_value) (a -> [Thread s r]
kn (a -> [Thread s r]) -> (a1 -> a) -> a1 -> [Thread s r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a1 -> a
a1_value))
Alt RE s a
n1 RE s a
n2 ->
let a1 :: Cont (a -> [Thread s r]) -> [Thread s r]
a1 = RE s a -> Cont (a -> [Thread s r]) -> [Thread s r]
forall s a r. RE s a -> Cont (a -> [Thread s r]) -> [Thread s r]
compile2 RE s a
n1
a2 :: Cont (a -> [Thread s r]) -> [Thread s r]
a2 = RE s a -> Cont (a -> [Thread s r]) -> [Thread s r]
forall s a r. RE s a -> Cont (a -> [Thread s r]) -> [Thread s r]
compile2 RE s a
n2
in \Cont (a -> [Thread s r])
k -> Cont (a -> [Thread s r]) -> [Thread s r]
a1 Cont (a -> [Thread s r])
k [Thread s r] -> [Thread s r] -> [Thread s r]
forall a. [a] -> [a] -> [a]
++ Cont (a -> [Thread s r]) -> [Thread s r]
a2 Cont (a -> [Thread s r])
k
RE s a
Fail -> [Thread s r] -> Cont (a -> [Thread s r]) -> [Thread s r]
forall a b. a -> b -> a
const []
Fmap a1 -> a
f RE s a1
n -> let a :: Cont (a1 -> [Thread s r]) -> [Thread s r]
a = RE s a1 -> Cont (a1 -> [Thread s r]) -> [Thread s r]
forall s a r. RE s a -> Cont (a -> [Thread s r]) -> [Thread s r]
compile2 RE s a1
n in \Cont (a -> [Thread s r])
k -> Cont (a1 -> [Thread s r]) -> [Thread s r]
a (Cont (a1 -> [Thread s r]) -> [Thread s r])
-> Cont (a1 -> [Thread s r]) -> [Thread s r]
forall a b. (a -> b) -> a -> b
$ ((a -> [Thread s r]) -> a1 -> [Thread s r])
-> Cont (a -> [Thread s r]) -> Cont (a1 -> [Thread s r])
forall a b. (a -> b) -> Cont a -> Cont b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> [Thread s r]) -> (a1 -> a) -> a1 -> [Thread s r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a1 -> a
f) Cont (a -> [Thread s r])
k
CatMaybes RE s (Maybe a)
n -> let a :: Cont (Maybe a -> [Thread s r]) -> [Thread s r]
a = RE s (Maybe a) -> Cont (Maybe a -> [Thread s r]) -> [Thread s r]
forall s a r. RE s a -> Cont (a -> [Thread s r]) -> [Thread s r]
compile2 RE s (Maybe a)
n in \Cont (a -> [Thread s r])
k -> Cont (Maybe a -> [Thread s r]) -> [Thread s r]
a (Cont (Maybe a -> [Thread s r]) -> [Thread s r])
-> Cont (Maybe a -> [Thread s r]) -> [Thread s r]
forall a b. (a -> b) -> a -> b
$ ((a -> [Thread s r]) -> (Maybe a -> [a]) -> Maybe a -> [Thread s r]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Maybe a -> [a]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) ((a -> [Thread s r]) -> Maybe a -> [Thread s r])
-> Cont (a -> [Thread s r]) -> Cont (Maybe a -> [Thread s r])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cont (a -> [Thread s r])
k
Rep Greediness
g a -> a1 -> a
f a
b RE s a1
n ->
let a :: Cont (a1 -> [Thread s r]) -> [Thread s r]
a = RE s a1 -> Cont (a1 -> [Thread s r]) -> [Thread s r]
forall s a r. RE s a -> Cont (a -> [Thread s r]) -> [Thread s r]
compile2 RE s a1
n
threads :: a -> Cont (a -> [Thread s r]) -> [Thread s r]
threads a
b Cont (a -> [Thread s r])
k =
Greediness -> [Thread s r] -> [Thread s r] -> [Thread s r]
forall a. Greediness -> [a] -> [a] -> [a]
combine Greediness
g
(Cont (a1 -> [Thread s r]) -> [Thread s r]
a (Cont (a1 -> [Thread s r]) -> [Thread s r])
-> Cont (a1 -> [Thread s r]) -> [Thread s r]
forall a b. (a -> b) -> a -> b
$ (a1 -> [Thread s r])
-> (a1 -> [Thread s r]) -> Cont (a1 -> [Thread s r])
forall a. a -> a -> Cont a
EmptyNonEmpty (\a1
_ -> []) (\a1
v -> let b' :: a
b' = a -> a1 -> a
f a
b a1
v in a -> Cont (a -> [Thread s r]) -> [Thread s r]
threads a
b' ((a -> [Thread s r]) -> Cont (a -> [Thread s r])
forall a. a -> Cont a
SingleCont ((a -> [Thread s r]) -> Cont (a -> [Thread s r]))
-> (a -> [Thread s r]) -> Cont (a -> [Thread s r])
forall a b. (a -> b) -> a -> b
$ Cont (a -> [Thread s r]) -> a -> [Thread s r]
forall a. Cont a -> a
nonEmptyCont Cont (a -> [Thread s r])
k)))
(Cont (a -> [Thread s r]) -> a -> [Thread s r]
forall a. Cont a -> a
emptyCont Cont (a -> [Thread s r])
k a
b)
in a -> Cont (a -> [Thread s r]) -> [Thread s r]
threads a
b
Void RE s a1
n
| RE s a1 -> Bool
forall s a. RE s a -> Bool
hasCatMaybes RE s a1
n -> RE s a1 -> Cont (a1 -> [Thread s r]) -> [Thread s r]
forall s a r. RE s a -> Cont (a -> [Thread s r]) -> [Thread s r]
compile2 RE s a1
n (Cont (a1 -> [Thread s r]) -> [Thread s r])
-> (Cont (a -> [Thread s r]) -> Cont (a1 -> [Thread s r]))
-> Cont (a -> [Thread s r])
-> [Thread s r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> [Thread s r]) -> a1 -> [Thread s r])
-> Cont (a -> [Thread s r]) -> Cont (a1 -> [Thread s r])
forall a b. (a -> b) -> Cont a -> Cont b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> [Thread s r]) -> (a1 -> a) -> a1 -> [Thread s r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \ a1
_ -> ())
| Bool
otherwise -> RE s a1 -> Cont [Thread s r] -> [Thread s r]
forall s a r. RE s a -> Cont [Thread s r] -> [Thread s r]
compile2_ RE s a1
n (Cont [Thread s r] -> [Thread s r])
-> (Cont (a -> [Thread s r]) -> Cont [Thread s r])
-> Cont (a -> [Thread s r])
-> [Thread s r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> [Thread s r]) -> [Thread s r])
-> Cont (a -> [Thread s r]) -> Cont [Thread s r]
forall a b. (a -> b) -> Cont a -> Cont b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((() -> [Thread s r]) -> () -> [Thread s r]
forall a b. (a -> b) -> a -> b
$ ())
data FSMState
= SAccept
| STransition !ThreadId
type FSMMap s = IntMap.IntMap (s -> Bool, [FSMState])
mkNFA :: RE s a -> ([FSMState], (FSMMap s))
mkNFA :: forall s a. RE s a -> ([FSMState], FSMMap s)
mkNFA RE s a
e =
(State (FSMMap s) [FSMState] -> FSMMap s -> ([FSMState], FSMMap s))
-> FSMMap s
-> State (FSMMap s) [FSMState]
-> ([FSMState], FSMMap s)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (FSMMap s) [FSMState] -> FSMMap s -> ([FSMState], FSMMap s)
forall s a. State s a -> s -> (a, s)
runState FSMMap s
forall a. IntMap a
IntMap.empty (State (FSMMap s) [FSMState] -> ([FSMState], FSMMap s))
-> State (FSMMap s) [FSMState] -> ([FSMState], FSMMap s)
forall a b. (a -> b) -> a -> b
$
RE s a -> [FSMState] -> State (FSMMap s) [FSMState]
forall s a. RE s a -> [FSMState] -> State (FSMMap s) [FSMState]
go RE s a
e [FSMState
SAccept]
where
go :: RE s a -> [FSMState] -> State (FSMMap s) [FSMState]
go :: forall s a. RE s a -> [FSMState] -> State (FSMMap s) [FSMState]
go RE s a
e [FSMState]
k =
case RE s a
e of
RE s a
Eps -> [FSMState] -> State (FSMMap s) [FSMState]
forall a. a -> StateT (FSMMap s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [FSMState]
k
Symbol i :: ThreadId
i@(ThreadId Int
n) s -> Maybe a
p -> do
(FSMMap s -> FSMMap s) -> StateT (FSMMap s) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((FSMMap s -> FSMMap s) -> StateT (FSMMap s) Identity ())
-> (FSMMap s -> FSMMap s) -> StateT (FSMMap s) Identity ()
forall a b. (a -> b) -> a -> b
$ Int -> (s -> Bool, [FSMState]) -> FSMMap s -> FSMMap s
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
n ((s -> Bool, [FSMState]) -> FSMMap s -> FSMMap s)
-> (s -> Bool, [FSMState]) -> FSMMap s -> FSMMap s
forall a b. (a -> b) -> a -> b
$
(Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> (s -> Maybe a) -> s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe a
p, [FSMState]
k)
[FSMState] -> State (FSMMap s) [FSMState]
forall a. a -> StateT (FSMMap s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [ThreadId -> FSMState
STransition ThreadId
i]
App RE s (a1 -> a)
n1 RE s a1
n2 -> RE s (a1 -> a) -> [FSMState] -> State (FSMMap s) [FSMState]
forall s a. RE s a -> [FSMState] -> State (FSMMap s) [FSMState]
go RE s (a1 -> a)
n1 ([FSMState] -> State (FSMMap s) [FSMState])
-> State (FSMMap s) [FSMState] -> State (FSMMap s) [FSMState]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RE s a1 -> [FSMState] -> State (FSMMap s) [FSMState]
forall s a. RE s a -> [FSMState] -> State (FSMMap s) [FSMState]
go RE s a1
n2 [FSMState]
k
Alt RE s a
n1 RE s a
n2 -> [FSMState] -> [FSMState] -> [FSMState]
forall a. [a] -> [a] -> [a]
(++) ([FSMState] -> [FSMState] -> [FSMState])
-> State (FSMMap s) [FSMState]
-> StateT (FSMMap s) Identity ([FSMState] -> [FSMState])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s a -> [FSMState] -> State (FSMMap s) [FSMState]
forall s a. RE s a -> [FSMState] -> State (FSMMap s) [FSMState]
go RE s a
n1 [FSMState]
k StateT (FSMMap s) Identity ([FSMState] -> [FSMState])
-> State (FSMMap s) [FSMState] -> State (FSMMap s) [FSMState]
forall a b.
StateT (FSMMap s) Identity (a -> b)
-> StateT (FSMMap s) Identity a -> StateT (FSMMap s) Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s a -> [FSMState] -> State (FSMMap s) [FSMState]
forall s a. RE s a -> [FSMState] -> State (FSMMap s) [FSMState]
go RE s a
n2 [FSMState]
k
RE s a
Fail -> [FSMState] -> State (FSMMap s) [FSMState]
forall a. a -> StateT (FSMMap s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Fmap a1 -> a
_ RE s a1
n -> RE s a1 -> [FSMState] -> State (FSMMap s) [FSMState]
forall s a. RE s a -> [FSMState] -> State (FSMMap s) [FSMState]
go RE s a1
n [FSMState]
k
CatMaybes RE s (Maybe a)
_ -> [Char] -> State (FSMMap s) [FSMState]
forall a. HasCallStack => [Char] -> a
error [Char]
"mkNFA CatMaybes"
Rep Greediness
g a -> a1 -> a
_ a
_ RE s a1
n ->
let entries :: [FSMState]
entries = RE s a1 -> [FSMState]
forall s a. RE s a -> [FSMState]
findEntries RE s a1
n
cont :: [FSMState]
cont = Greediness -> [FSMState] -> [FSMState] -> [FSMState]
forall a. Greediness -> [a] -> [a] -> [a]
combine Greediness
g [FSMState]
entries [FSMState]
k
in
RE s a1 -> [FSMState] -> State (FSMMap s) [FSMState]
forall s a. RE s a -> [FSMState] -> State (FSMMap s) [FSMState]
go RE s a1
n [FSMState]
cont State (FSMMap s) [FSMState]
-> State (FSMMap s) [FSMState] -> State (FSMMap s) [FSMState]
forall a b.
StateT (FSMMap s) Identity a
-> StateT (FSMMap s) Identity b -> StateT (FSMMap s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [FSMState] -> State (FSMMap s) [FSMState]
forall a. a -> StateT (FSMMap s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [FSMState]
cont
Void RE s a1
n -> RE s a1 -> [FSMState] -> State (FSMMap s) [FSMState]
forall s a. RE s a -> [FSMState] -> State (FSMMap s) [FSMState]
go RE s a1
n [FSMState]
k
findEntries :: RE s a -> [FSMState]
findEntries :: forall s a. RE s a -> [FSMState]
findEntries RE s a
e =
State (FSMMap s) [FSMState] -> FSMMap s -> [FSMState]
forall s a. State s a -> s -> a
evalState (RE s a -> [FSMState] -> State (FSMMap s) [FSMState]
forall s a. RE s a -> [FSMState] -> State (FSMMap s) [FSMState]
go RE s a
e []) FSMMap s
forall a. IntMap a
IntMap.empty
hasCatMaybes :: RE s a -> Bool
hasCatMaybes :: forall s a. RE s a -> Bool
hasCatMaybes = Any -> Bool
getAny (Any -> Bool) -> (RE s a -> Any) -> RE s a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a1. RE s a1 -> Any) -> RE s a -> Any
forall b s a. Monoid b => (forall a1. RE s a1 -> b) -> RE s a -> b
foldMapPostorder (Bool -> Any
Any (Bool -> Any) -> (RE s a1 -> Bool) -> RE s a1 -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \ case CatMaybes RE s (Maybe a1)
_ -> Bool
True; RE s a1
_ -> Bool
False)
compile2_ :: RE s a -> Cont [Thread s r] -> [Thread s r]
compile2_ :: forall s a r. RE s a -> Cont [Thread s r] -> [Thread s r]
compile2_ RE s a
e =
let ([FSMState]
entries, FSMMap s
fsmap) = RE s a -> ([FSMState], FSMMap s)
forall s a. RE s a -> ([FSMState], FSMMap s)
mkNFA RE s a
e
mkThread :: [Thread s r] -> [Thread s r] -> FSMState -> [Thread s r]
mkThread [Thread s r]
_ [Thread s r]
k1 (STransition i :: ThreadId
i@(ThreadId Int
n)) =
let (s -> Bool
p, [FSMState]
cont) = (s -> Bool, [FSMState])
-> Maybe (s -> Bool, [FSMState]) -> (s -> Bool, [FSMState])
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (s -> Bool, [FSMState])
forall a. HasCallStack => [Char] -> a
error [Char]
"Unknown id") (Maybe (s -> Bool, [FSMState]) -> (s -> Bool, [FSMState]))
-> Maybe (s -> Bool, [FSMState]) -> (s -> Bool, [FSMState])
forall a b. (a -> b) -> a -> b
$ Int -> FSMMap s -> Maybe (s -> Bool, [FSMState])
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
n FSMMap s
fsmap
in [ThreadId -> (s -> [Thread s r]) -> Thread s r
forall s r. ThreadId -> (s -> [Thread s r]) -> Thread s r
Thread ThreadId
i ((s -> [Thread s r]) -> Thread s r)
-> (s -> [Thread s r]) -> Thread s r
forall a b. (a -> b) -> a -> b
$ \s
s ->
if s -> Bool
p s
s
then (FSMState -> [Thread s r]) -> [FSMState] -> [Thread s r]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Thread s r] -> [Thread s r] -> FSMState -> [Thread s r]
mkThread [Thread s r]
k1 [Thread s r]
k1) [FSMState]
cont
else []]
mkThread [Thread s r]
k0 [Thread s r]
_ FSMState
SAccept = [Thread s r]
k0
in \Cont [Thread s r]
k -> (FSMState -> [Thread s r]) -> [FSMState] -> [Thread s r]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Thread s r] -> [Thread s r] -> FSMState -> [Thread s r]
mkThread (Cont [Thread s r] -> [Thread s r]
forall a. Cont a -> a
emptyCont Cont [Thread s r]
k) (Cont [Thread s r] -> [Thread s r]
forall a. Cont a -> a
nonEmptyCont Cont [Thread s r]
k)) [FSMState]
entries
combine :: Greediness -> [a] -> [a] -> [a]
combine :: forall a. Greediness -> [a] -> [a] -> [a]
combine Greediness
g [a]
continue [a]
stop =
case Greediness
g of
Greediness
Greedy -> [a]
continue [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
stop
Greediness
NonGreedy -> [a]
stop [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
continue