module Events.EqGuard(
EqGuardedChannel,
EqMatch(..),
newEqGuardedChannel,
) where
import Util.Computation
import Events.GuardedEvents
import Events.GuardedChannels
import Events.DeleteQueue
import Events.FMQueue
type EqGuardedChannel key value = GuardedChannel (EqMatch key) (key,value)
newEqGuardedChannel :: Ord key => IO (EqGuardedChannel key value)
newEqGuardedChannel =
newEqGuardedChannelPrim (error "EqGuard.1") (error "EqGuard.2")
newEqGuardedChannelPrim :: Ord key => key -> value
-> IO (EqGuardedChannel key value)
newEqGuardedChannelPrim (_::key) (_ ::value) =
newGuardedChannel (error "newEq1" :: (GQ (EqGuardQueue key) (key,value)))
(error "newEq2" :: (VQ (EqValueQueue key value)))
data EqMatch key =
Eq !key
| EqMatchAny
| EqMatchNone
instance Ord key => Guard (EqMatch key) where
nullGuard = EqMatchAny
andGuard EqMatchAny x = x
andGuard EqMatchNone x = EqMatchNone
andGuard x EqMatchAny = x
andGuard x EqMatchNone = EqMatchNone
andGuard (Eq key1) (Eq key2) =
if key1 == key2 then Eq key1 else EqMatchNone
newtype Ord key => EqValueQueue key value valueCont =
EqValueQueue (FMQueue key ((key,value),valueCont))
instance Ord key => HasEmpty (EqValueQueue key value) where
newEmpty = return (EqValueQueue emptyFMQueue)
instance Ord key => HasAdd (EqValueQueue key value) (key,value) where
add (EqValueQueue fmQueue) keyValue@(key,value) valueCont =
do
(fmQueue2,invalidate) <- addFMQueue fmQueue key (keyValue,valueCont)
return (EqValueQueue fmQueue2,invalidate)
instance Ord key => HasRemove (EqValueQueue key value) (EqMatch key)
(key,value) where
remove (EqValueQueue fmQueue) EqMatchAny =
do
(removed,fmQueue0) <- removeFMQueueAny fmQueue
case removed of
Nothing -> return (Nothing,EqValueQueue fmQueue0)
(Just (_,(keyValue,valueCont),fmQueue2)) ->
return (Just(keyValue,valueCont,
return (EqValueQueue fmQueue0)),
EqValueQueue fmQueue2)
remove (EqValueQueue fmQueue) (Eq key) =
do
(removed,fmQueue0) <- removeFMQueue fmQueue key
case removed of
Nothing -> return (Nothing,EqValueQueue fmQueue0)
(Just ((keyValue,valueCont),fmQueue2)) ->
return (Just(keyValue,valueCont,
return (EqValueQueue fmQueue0)),
EqValueQueue fmQueue2)
data Ord key => EqGuardQueue key guardCont =
EqGuardQueue {
matchAnys :: DeleteQueue guardCont,
eqs :: FMQueue key guardCont
}
instance Ord key => HasEmpty (EqGuardQueue key) where
newEmpty = return (EqGuardQueue {
matchAnys = emptyQueue,
eqs = emptyFMQueue
})
instance Ord key => HasAdd (EqGuardQueue key) (EqMatch key) where
add guardQueue guard guardCont =
case guard of
Eq key ->
do
let fmQueue = eqs guardQueue
(fmQueue2,invalidate) <- addFMQueue fmQueue key guardCont
return (guardQueue {eqs = fmQueue2},invalidate)
EqMatchAny ->
do
let deleteQueue = matchAnys guardQueue
(deleteQueue2,invalidate) <- addQueue deleteQueue guardCont
deleteQueue3 <- cleanQueue deleteQueue2
return (guardQueue {matchAnys = deleteQueue2},invalidate)
EqMatchNone -> return (guardQueue,done)
instance Ord key => HasRemove (EqGuardQueue key) (key,value) (EqMatch key) where
remove guardQueue (key,_) =
do
removed <- removeFMQueue (eqs guardQueue) key
case removed of
(Just (guardCont,fmQueue2),fmQueue0) ->
do
let gq fmq = guardQueue {eqs = fmq}
return (Just(Eq key,guardCont,return(gq fmQueue0)),
gq fmQueue2)
(Nothing,fmQueue0) ->
do
let
mAs = matchAnys guardQueue
gq dq = EqGuardQueue {matchAnys = dq,eqs = fmQueue0}
removed2 <- removeQueue mAs
case removed2 of
Just (guardCont,dqueue2,dqueue0) ->
return (Just (EqMatchAny,guardCont,
return (gq dqueue0)),
gq dqueue2)
Nothing ->
return (Nothing,gq mAs)