module Dynforkmerge(DynMsg(..), DynSPMsg(..), dynforkmerge) where
import SP
import Utils(part)

data DynMsg a b = DynCreate b |
                  DynDestroy |
                  DynMsg a 
                  deriving (DynMsg a b -> DynMsg a b -> Bool
(DynMsg a b -> DynMsg a b -> Bool)
-> (DynMsg a b -> DynMsg a b -> Bool) -> Eq (DynMsg a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq b, Eq a) => DynMsg a b -> DynMsg a b -> Bool
/= :: DynMsg a b -> DynMsg a b -> Bool
$c/= :: forall a b. (Eq b, Eq a) => DynMsg a b -> DynMsg a b -> Bool
== :: DynMsg a b -> DynMsg a b -> Bool
$c== :: forall a b. (Eq b, Eq a) => DynMsg a b -> DynMsg a b -> Bool
Eq, Eq (DynMsg a b)
Eq (DynMsg a b)
-> (DynMsg a b -> DynMsg a b -> Ordering)
-> (DynMsg a b -> DynMsg a b -> Bool)
-> (DynMsg a b -> DynMsg a b -> Bool)
-> (DynMsg a b -> DynMsg a b -> Bool)
-> (DynMsg a b -> DynMsg a b -> Bool)
-> (DynMsg a b -> DynMsg a b -> DynMsg a b)
-> (DynMsg a b -> DynMsg a b -> DynMsg a b)
-> Ord (DynMsg a b)
DynMsg a b -> DynMsg a b -> Bool
DynMsg a b -> DynMsg a b -> Ordering
DynMsg a b -> DynMsg a b -> DynMsg a b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a b. (Ord b, Ord a) => Eq (DynMsg a b)
forall a b. (Ord b, Ord a) => DynMsg a b -> DynMsg a b -> Bool
forall a b. (Ord b, Ord a) => DynMsg a b -> DynMsg a b -> Ordering
forall a b.
(Ord b, Ord a) =>
DynMsg a b -> DynMsg a b -> DynMsg a b
min :: DynMsg a b -> DynMsg a b -> DynMsg a b
$cmin :: forall a b.
(Ord b, Ord a) =>
DynMsg a b -> DynMsg a b -> DynMsg a b
max :: DynMsg a b -> DynMsg a b -> DynMsg a b
$cmax :: forall a b.
(Ord b, Ord a) =>
DynMsg a b -> DynMsg a b -> DynMsg a b
>= :: DynMsg a b -> DynMsg a b -> Bool
$c>= :: forall a b. (Ord b, Ord a) => DynMsg a b -> DynMsg a b -> Bool
> :: DynMsg a b -> DynMsg a b -> Bool
$c> :: forall a b. (Ord b, Ord a) => DynMsg a b -> DynMsg a b -> Bool
<= :: DynMsg a b -> DynMsg a b -> Bool
$c<= :: forall a b. (Ord b, Ord a) => DynMsg a b -> DynMsg a b -> Bool
< :: DynMsg a b -> DynMsg a b -> Bool
$c< :: forall a b. (Ord b, Ord a) => DynMsg a b -> DynMsg a b -> Bool
compare :: DynMsg a b -> DynMsg a b -> Ordering
$ccompare :: forall a b. (Ord b, Ord a) => DynMsg a b -> DynMsg a b -> Ordering
$cp1Ord :: forall a b. (Ord b, Ord a) => Eq (DynMsg a b)
Ord)

type DynSPMsg a b = DynMsg a (SP a b)

dynforkmerge :: Eq a => SP (a, DynSPMsg b c) (a, c)
dynforkmerge :: SP (a, DynSPMsg b c) (a, c)
dynforkmerge = [(a, b -> SP b c)] -> SP (a, DynSPMsg b c) (a, c)
forall a a b.
Eq a =>
[(a, a -> SP a b)] -> SP (a, DynMsg a (SP a b)) (a, b)
dfm []

dfm :: [(a, a -> SP a b)] -> SP (a, DynMsg a (SP a b)) (a, b)
dfm [(a, a -> SP a b)]
dynxsps =
    ((a, DynMsg a (SP a b)) -> SP (a, DynMsg a (SP a b)) (a, b))
-> SP (a, DynMsg a (SP a b)) (a, b)
forall a b. (a -> SP a b) -> SP a b
GetSP (\(a, DynMsg a (SP a b))
msg ->
           case (a, DynMsg a (SP a b))
msg of
             (a
t, DynCreate SP a b
dynsp) -> a
-> SP a b -> [(a, a -> SP a b)] -> SP (a, DynMsg a (SP a b)) (a, b)
dfmout a
t SP a b
dynsp [(a, a -> SP a b)]
dynxsps
             (a
t, DynMsg a
msg') -> a -> a -> [(a, a -> SP a b)] -> SP (a, DynMsg a (SP a b)) (a, b)
dfmin a
t a
msg' [(a, a -> SP a b)]
dynxsps
             (a
t, DynMsg a (SP a b)
DynDestroy) -> a -> [(a, a -> SP a b)] -> SP (a, DynMsg a (SP a b)) (a, b)
dfmrm a
t [(a, a -> SP a b)]
dynxsps)

dfmout :: a
-> SP a b -> [(a, a -> SP a b)] -> SP (a, DynMsg a (SP a b)) (a, b)
dfmout a
t SP a b
dynsp [(a, a -> SP a b)]
dynxsps =
    case SP a b
dynsp of
      PutSP b
y SP a b
sp' -> (a, b)
-> SP (a, DynMsg a (SP a b)) (a, b)
-> SP (a, DynMsg a (SP a b)) (a, b)
forall a b. b -> SP a b -> SP a b
PutSP (a
t, b
y) (a
-> SP a b -> [(a, a -> SP a b)] -> SP (a, DynMsg a (SP a b)) (a, b)
dfmout a
t SP a b
sp' [(a, a -> SP a b)]
dynxsps)
      GetSP a -> SP a b
xsp -> [(a, a -> SP a b)] -> SP (a, DynMsg a (SP a b)) (a, b)
dfm ((a
t, a -> SP a b
xsp) (a, a -> SP a b) -> [(a, a -> SP a b)] -> [(a, a -> SP a b)]
forall a. a -> [a] -> [a]
: [(a, a -> SP a b)]
dynxsps)
      SP a b
NullSP -> [(a, a -> SP a b)] -> SP (a, DynMsg a (SP a b)) (a, b)
dfm [(a, a -> SP a b)]
dynxsps

dfmin :: a -> a -> [(a, a -> SP a b)] -> SP (a, DynMsg a (SP a b)) (a, b)
dfmin a
t a
msg [(a, a -> SP a b)]
dynxsps =
    case ((a, a -> SP a b) -> Bool)
-> [(a, a -> SP a b)] -> ([(a, a -> SP a b)], [(a, a -> SP a b)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
part ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
t) (a -> Bool) -> ((a, a -> SP a b) -> a) -> (a, a -> SP a b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a -> SP a b) -> a
forall a b. (a, b) -> a
fst) [(a, a -> SP a b)]
dynxsps of
      ([], [(a, a -> SP a b)]
_) -> [(a, a -> SP a b)] -> SP (a, DynMsg a (SP a b)) (a, b)
dfm [(a, a -> SP a b)]
dynxsps
      ([(a
_, a -> SP a b
xsp)], [(a, a -> SP a b)]
dynxsps') -> a
-> SP a b -> [(a, a -> SP a b)] -> SP (a, DynMsg a (SP a b)) (a, b)
dfmout a
t (a -> SP a b
xsp a
msg) [(a, a -> SP a b)]
dynxsps'
      ([(a, a -> SP a b)], [(a, a -> SP a b)])
_ -> [Char] -> SP (a, DynMsg a (SP a b)) (a, b)
forall a. HasCallStack => [Char] -> a
error [Char]
"Same tag used twice in dynforkmerge (or dynListF)."

dfmrm :: a -> [(a, a -> SP a b)] -> SP (a, DynMsg a (SP a b)) (a, b)
dfmrm a
t [(a, a -> SP a b)]
dynxsps = [(a, a -> SP a b)] -> SP (a, DynMsg a (SP a b)) (a, b)
dfm (((a, a -> SP a b) -> Bool)
-> [(a, a -> SP a b)] -> [(a, a -> SP a b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=) (a -> Bool) -> ((a, a -> SP a b) -> a) -> (a, a -> SP a b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a -> SP a b) -> a
forall a b. (a, b) -> a
fst) [(a, a -> SP a b)]
dynxsps)