module Events.Channels(
Channel,
newChannel,
) where
import Control.Concurrent
import Util.Computation(done)
import Util.Queue
import Events.Toggle
import Events.Events
newtype Channel a = Channel (MVar (Queue (Toggle,a,IO () -> IO ()),
Queue (Toggle,IO a -> IO ()),Int))
data Res a = None | Anticipated | Found a
cleanPar :: Int
cleanPar :: Int
cleanPar = Int
10
newChannel :: IO (Channel a)
newChannel :: IO (Channel a)
newChannel =
do
MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
mVar <- (Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
-> IO
(MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int))
forall a. a -> IO (MVar a)
newMVar (Queue (Toggle, a, IO () -> IO ())
forall a. Queue a
emptyQ,Queue (Toggle, IO a -> IO ())
forall a. Queue a
emptyQ,Int
0)
Channel a -> IO (Channel a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
-> Channel a
forall a.
MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
-> Channel a
Channel MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
mVar)
instance HasSend Channel where
send :: Channel a -> a -> Event ()
send (Channel MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
mVar) a
value = (Toggle -> (IO () -> IO ()) -> IO Result) -> Event ()
forall a. (Toggle -> (IO a -> IO ()) -> IO Result) -> Event a
Event (
\ Toggle
toggle IO () -> IO ()
continuation ->
do
(Queue (Toggle, a, IO () -> IO ())
sQueue,Queue (Toggle, IO a -> IO ())
rQueue,Int
counter) <- MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
-> IO
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
forall a. MVar a -> IO a
takeMVar MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
mVar
(Queue (Toggle, IO a -> IO ())
rQueueOut,Res (IO a -> IO ())
res) <- Toggle
-> Queue (Toggle, IO a -> IO ())
-> IO (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
forall a.
Toggle
-> Queue (Toggle, IO a -> IO ())
-> IO (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
matchSend Toggle
toggle Queue (Toggle, IO a -> IO ())
rQueue
case Res (IO a -> IO ())
res of
Res (IO a -> IO ())
None ->
do
let
sQueue2 :: Queue (Toggle, a, IO () -> IO ())
sQueue2 = Queue (Toggle, a, IO () -> IO ())
-> (Toggle, a, IO () -> IO ()) -> Queue (Toggle, a, IO () -> IO ())
forall a. Queue a -> a -> Queue a
insertQ Queue (Toggle, a, IO () -> IO ())
sQueue (Toggle
toggle,a
value,IO () -> IO ()
continuation)
(Queue (Toggle, a, IO () -> IO ())
sQueue3,Int
counter) <-
if Int
counterInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
cleanPar
then
do
Queue (Toggle, a, IO () -> IO ())
sQueue3 <- Queue (Toggle, a, IO () -> IO ())
-> IO (Queue (Toggle, a, IO () -> IO ()))
forall a.
Queue (Toggle, a, IO () -> IO ())
-> IO (Queue (Toggle, a, IO () -> IO ()))
cleanSends Queue (Toggle, a, IO () -> IO ())
sQueue2
(Queue (Toggle, a, IO () -> IO ()), Int)
-> IO (Queue (Toggle, a, IO () -> IO ()), Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, a, IO () -> IO ())
sQueue3,Int
0)
else
(Queue (Toggle, a, IO () -> IO ()), Int)
-> IO (Queue (Toggle, a, IO () -> IO ()), Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, a, IO () -> IO ())
sQueue2,Int
counterInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
-> (Queue (Toggle, a, IO () -> IO ()),
Queue (Toggle, IO a -> IO ()), Int)
-> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
mVar (Queue (Toggle, a, IO () -> IO ())
sQueue3,Queue (Toggle, IO a -> IO ())
rQueueOut,Int
counter)
Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return(IO () -> Result
Awaiting IO ()
forall (m :: * -> *). Monad m => m ()
done)
Res (IO a -> IO ())
Anticipated ->
do
MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
-> (Queue (Toggle, a, IO () -> IO ()),
Queue (Toggle, IO a -> IO ()), Int)
-> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
mVar (Queue (Toggle, a, IO () -> IO ())
sQueue,Queue (Toggle, IO a -> IO ())
rQueueOut,Int
counter)
Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
Immediate
Found IO a -> IO ()
acontinuation ->
do
MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
-> (Queue (Toggle, a, IO () -> IO ()),
Queue (Toggle, IO a -> IO ()), Int)
-> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
mVar (Queue (Toggle, a, IO () -> IO ())
sQueue,Queue (Toggle, IO a -> IO ())
rQueueOut,Int
0)
IO () -> IO ()
continuation (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
IO a -> IO ()
acontinuation (a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
value)
Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
Immediate)
cleanSends :: Queue (Toggle,a,IO () -> IO ())
-> IO (Queue (Toggle,a,IO () -> IO()))
cleanSends :: Queue (Toggle, a, IO () -> IO ())
-> IO (Queue (Toggle, a, IO () -> IO ()))
cleanSends Queue (Toggle, a, IO () -> IO ())
queue =
case Queue (Toggle, a, IO () -> IO ())
-> Maybe
((Toggle, a, IO () -> IO ()), Queue (Toggle, a, IO () -> IO ()))
forall a. Queue a -> Maybe (a, Queue a)
removeQ Queue (Toggle, a, IO () -> IO ())
queue of
Maybe
((Toggle, a, IO () -> IO ()), Queue (Toggle, a, IO () -> IO ()))
Nothing -> Queue (Toggle, a, IO () -> IO ())
-> IO (Queue (Toggle, a, IO () -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Queue (Toggle, a, IO () -> IO ())
forall a. Queue a
emptyQ
Just (sendReg :: (Toggle, a, IO () -> IO ())
sendReg@(Toggle
toggle,a
_,IO () -> IO ()
_),Queue (Toggle, a, IO () -> IO ())
rest) ->
do
Bool
peek <- Toggle -> IO Bool
peekToggle Toggle
toggle
if Bool
peek
then
Queue (Toggle, a, IO () -> IO ())
-> IO (Queue (Toggle, a, IO () -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, a, IO () -> IO ())
-> (Toggle, a, IO () -> IO ()) -> Queue (Toggle, a, IO () -> IO ())
forall a. Queue a -> a -> Queue a
insertAtEndQ Queue (Toggle, a, IO () -> IO ())
rest (Toggle, a, IO () -> IO ())
sendReg)
else
Queue (Toggle, a, IO () -> IO ())
-> IO (Queue (Toggle, a, IO () -> IO ()))
forall a.
Queue (Toggle, a, IO () -> IO ())
-> IO (Queue (Toggle, a, IO () -> IO ()))
cleanSends Queue (Toggle, a, IO () -> IO ())
rest
matchSend :: Toggle -> Queue (Toggle,IO a -> IO ())
-> IO (Queue (Toggle,IO a -> IO ()),Res (IO a -> IO ()))
matchSend :: Toggle
-> Queue (Toggle, IO a -> IO ())
-> IO (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
matchSend Toggle
sendToggle Queue (Toggle, IO a -> IO ())
queueIn =
case Queue (Toggle, IO a -> IO ())
-> Maybe ((Toggle, IO a -> IO ()), Queue (Toggle, IO a -> IO ()))
forall a. Queue a -> Maybe (a, Queue a)
removeQ Queue (Toggle, IO a -> IO ())
queueIn of
Maybe ((Toggle, IO a -> IO ()), Queue (Toggle, IO a -> IO ()))
Nothing -> (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
-> IO (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, IO a -> IO ())
queueIn,Res (IO a -> IO ())
forall a. Res a
None)
Just (rc :: (Toggle, IO a -> IO ())
rc@(Toggle
receiveToggle,IO a -> IO ()
continuation),Queue (Toggle, IO a -> IO ())
queueOut) ->
do
Maybe (Bool, Bool)
tog <- Toggle -> Toggle -> IO (Maybe (Bool, Bool))
toggle2 Toggle
sendToggle Toggle
receiveToggle
case Maybe (Bool, Bool)
tog of
Maybe (Bool, Bool)
Nothing -> (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
-> IO (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, IO a -> IO ())
queueOut,(IO a -> IO ()) -> Res (IO a -> IO ())
forall a. a -> Res a
Found IO a -> IO ()
continuation)
Just(Bool
True,Bool
True) ->
do
(Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
match2 <- Toggle
-> Queue (Toggle, IO a -> IO ())
-> IO (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
forall a.
Toggle
-> Queue (Toggle, IO a -> IO ())
-> IO (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
matchSend Toggle
sendToggle Queue (Toggle, IO a -> IO ())
queueOut
case (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
match2 of
(Queue (Toggle, IO a -> IO ())
queueOut,Res (IO a -> IO ())
None) ->
(Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
-> IO (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, IO a -> IO ())
-> (Toggle, IO a -> IO ()) -> Queue (Toggle, IO a -> IO ())
forall a. Queue a -> a -> Queue a
insertAtEndQ Queue (Toggle, IO a -> IO ())
queueOut (Toggle, IO a -> IO ())
rc,Res (IO a -> IO ())
forall a. Res a
None)
(Queue (Toggle, IO a -> IO ())
queueOut,Res (IO a -> IO ())
Anticipated) ->
(Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
-> IO (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, IO a -> IO ())
queueOut,Res (IO a -> IO ())
forall a. Res a
Anticipated)
(Queue (Toggle, IO a -> IO ())
queueOut,Res (IO a -> IO ())
found) ->
(Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
-> IO (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, IO a -> IO ())
queueOut,Res (IO a -> IO ())
found)
Just(Bool
True,Bool
False) -> Toggle
-> Queue (Toggle, IO a -> IO ())
-> IO (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
forall a.
Toggle
-> Queue (Toggle, IO a -> IO ())
-> IO (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
matchSend Toggle
sendToggle Queue (Toggle, IO a -> IO ())
queueOut
Just(Bool
False,Bool
True) ->
(Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
-> IO (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, IO a -> IO ())
-> (Toggle, IO a -> IO ()) -> Queue (Toggle, IO a -> IO ())
forall a. Queue a -> a -> Queue a
insertAtEndQ Queue (Toggle, IO a -> IO ())
queueOut (Toggle, IO a -> IO ())
rc,Res (IO a -> IO ())
forall a. Res a
Anticipated)
Just(Bool
False,Bool
False) -> (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
-> IO (Queue (Toggle, IO a -> IO ()), Res (IO a -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, IO a -> IO ())
queueOut,Res (IO a -> IO ())
forall a. Res a
Anticipated)
instance HasReceive Channel where
receive :: Channel a -> Event a
receive (Channel MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
mVar) = (Toggle -> (IO a -> IO ()) -> IO Result) -> Event a
forall a. (Toggle -> (IO a -> IO ()) -> IO Result) -> Event a
Event (
\ Toggle
toggle IO a -> IO ()
acontinuation ->
do
(Queue (Toggle, a, IO () -> IO ())
sQueue,Queue (Toggle, IO a -> IO ())
rQueue,Int
counter) <- MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
-> IO
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
forall a. MVar a -> IO a
takeMVar MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
mVar
(Queue (Toggle, a, IO () -> IO ())
sQueueOut,Res (a, IO () -> IO ())
res) <- Toggle
-> Queue (Toggle, a, IO () -> IO ())
-> IO (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
forall a.
Toggle
-> Queue (Toggle, a, IO () -> IO ())
-> IO (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
matchReceive Toggle
toggle Queue (Toggle, a, IO () -> IO ())
sQueue
case Res (a, IO () -> IO ())
res of
Res (a, IO () -> IO ())
None ->
do
let
rQueue2 :: Queue (Toggle, IO a -> IO ())
rQueue2 = Queue (Toggle, IO a -> IO ())
-> (Toggle, IO a -> IO ()) -> Queue (Toggle, IO a -> IO ())
forall a. Queue a -> a -> Queue a
insertQ Queue (Toggle, IO a -> IO ())
rQueue (Toggle
toggle,IO a -> IO ()
acontinuation)
(Queue (Toggle, IO a -> IO ())
rQueue3,Int
counter) <-
if Int
counterInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
cleanPar
then
do
Queue (Toggle, IO a -> IO ())
rQueue3 <- Queue (Toggle, IO a -> IO ()) -> IO (Queue (Toggle, IO a -> IO ()))
forall a.
Queue (Toggle, IO a -> IO ()) -> IO (Queue (Toggle, IO a -> IO ()))
cleanReceives Queue (Toggle, IO a -> IO ())
rQueue2
(Queue (Toggle, IO a -> IO ()), Int)
-> IO (Queue (Toggle, IO a -> IO ()), Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, IO a -> IO ())
rQueue3,Int
0)
else
(Queue (Toggle, IO a -> IO ()), Int)
-> IO (Queue (Toggle, IO a -> IO ()), Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, IO a -> IO ())
rQueue2,Int
counterInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
-> (Queue (Toggle, a, IO () -> IO ()),
Queue (Toggle, IO a -> IO ()), Int)
-> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
mVar (Queue (Toggle, a, IO () -> IO ())
sQueueOut,Queue (Toggle, IO a -> IO ())
rQueue3,Int
counter)
Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return(IO () -> Result
Awaiting IO ()
forall (m :: * -> *). Monad m => m ()
done)
Res (a, IO () -> IO ())
Anticipated ->
do
MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
-> (Queue (Toggle, a, IO () -> IO ()),
Queue (Toggle, IO a -> IO ()), Int)
-> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
mVar (Queue (Toggle, a, IO () -> IO ())
sQueueOut,Queue (Toggle, IO a -> IO ())
rQueue,Int
counter)
Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
Immediate
Found (a
value,IO () -> IO ()
continuation) ->
do
MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
-> (Queue (Toggle, a, IO () -> IO ()),
Queue (Toggle, IO a -> IO ()), Int)
-> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar
(Queue (Toggle, a, IO () -> IO ()), Queue (Toggle, IO a -> IO ()),
Int)
mVar (Queue (Toggle, a, IO () -> IO ())
sQueueOut,Queue (Toggle, IO a -> IO ())
rQueue,Int
counter)
IO () -> IO ()
continuation (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
IO a -> IO ()
acontinuation (a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
value)
Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
Immediate
)
matchReceive :: Toggle -> Queue (Toggle,a,IO () -> IO ())
-> IO (Queue (Toggle,a,IO () -> IO ()),Res (a,IO () -> IO ()))
matchReceive :: Toggle
-> Queue (Toggle, a, IO () -> IO ())
-> IO (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
matchReceive Toggle
receiveToggle Queue (Toggle, a, IO () -> IO ())
queueIn =
case Queue (Toggle, a, IO () -> IO ())
-> Maybe
((Toggle, a, IO () -> IO ()), Queue (Toggle, a, IO () -> IO ()))
forall a. Queue a -> Maybe (a, Queue a)
removeQ Queue (Toggle, a, IO () -> IO ())
queueIn of
Maybe
((Toggle, a, IO () -> IO ()), Queue (Toggle, a, IO () -> IO ()))
Nothing -> (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
-> IO (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, a, IO () -> IO ())
queueIn,Res (a, IO () -> IO ())
forall a. Res a
None)
Just (rc :: (Toggle, a, IO () -> IO ())
rc@(Toggle
sendToggle,a
value,IO () -> IO ()
continuation),Queue (Toggle, a, IO () -> IO ())
queueOut) ->
do
Maybe (Bool, Bool)
tog <- Toggle -> Toggle -> IO (Maybe (Bool, Bool))
toggle2 Toggle
receiveToggle Toggle
sendToggle
case Maybe (Bool, Bool)
tog of
Maybe (Bool, Bool)
Nothing -> (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
-> IO (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, a, IO () -> IO ())
queueOut,(a, IO () -> IO ()) -> Res (a, IO () -> IO ())
forall a. a -> Res a
Found (a
value,IO () -> IO ()
continuation))
Just(Bool
True,Bool
True) ->
do
(Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
match2 <- Toggle
-> Queue (Toggle, a, IO () -> IO ())
-> IO (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
forall a.
Toggle
-> Queue (Toggle, a, IO () -> IO ())
-> IO (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
matchReceive Toggle
receiveToggle Queue (Toggle, a, IO () -> IO ())
queueOut
case (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
match2 of
(Queue (Toggle, a, IO () -> IO ())
queueOut,Res (a, IO () -> IO ())
None) ->
(Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
-> IO (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, a, IO () -> IO ())
-> (Toggle, a, IO () -> IO ()) -> Queue (Toggle, a, IO () -> IO ())
forall a. Queue a -> a -> Queue a
insertAtEndQ Queue (Toggle, a, IO () -> IO ())
queueOut (Toggle, a, IO () -> IO ())
rc,Res (a, IO () -> IO ())
forall a. Res a
None)
(Queue (Toggle, a, IO () -> IO ())
queueOut,Res (a, IO () -> IO ())
Anticipated) ->
(Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
-> IO (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, a, IO () -> IO ())
queueOut,Res (a, IO () -> IO ())
forall a. Res a
Anticipated)
(Queue (Toggle, a, IO () -> IO ())
queueOut,Res (a, IO () -> IO ())
found) ->
(Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
-> IO (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, a, IO () -> IO ())
queueOut,Res (a, IO () -> IO ())
found)
Just(Bool
True,Bool
False) -> Toggle
-> Queue (Toggle, a, IO () -> IO ())
-> IO (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
forall a.
Toggle
-> Queue (Toggle, a, IO () -> IO ())
-> IO (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
matchReceive Toggle
receiveToggle Queue (Toggle, a, IO () -> IO ())
queueOut
Just(Bool
False,Bool
True) ->
(Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
-> IO (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, a, IO () -> IO ())
-> (Toggle, a, IO () -> IO ()) -> Queue (Toggle, a, IO () -> IO ())
forall a. Queue a -> a -> Queue a
insertAtEndQ Queue (Toggle, a, IO () -> IO ())
queueOut (Toggle, a, IO () -> IO ())
rc,Res (a, IO () -> IO ())
forall a. Res a
Anticipated)
Just(Bool
False,Bool
False) -> (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
-> IO (Queue (Toggle, a, IO () -> IO ()), Res (a, IO () -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, a, IO () -> IO ())
queueOut,Res (a, IO () -> IO ())
forall a. Res a
Anticipated)
cleanReceives :: Queue (Toggle,IO a -> IO ())
-> IO (Queue (Toggle,IO a -> IO ()))
cleanReceives :: Queue (Toggle, IO a -> IO ()) -> IO (Queue (Toggle, IO a -> IO ()))
cleanReceives Queue (Toggle, IO a -> IO ())
queue =
case Queue (Toggle, IO a -> IO ())
-> Maybe ((Toggle, IO a -> IO ()), Queue (Toggle, IO a -> IO ()))
forall a. Queue a -> Maybe (a, Queue a)
removeQ Queue (Toggle, IO a -> IO ())
queue of
Maybe ((Toggle, IO a -> IO ()), Queue (Toggle, IO a -> IO ()))
Nothing -> Queue (Toggle, IO a -> IO ()) -> IO (Queue (Toggle, IO a -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Queue (Toggle, IO a -> IO ())
forall a. Queue a
emptyQ
Just (receiveReg :: (Toggle, IO a -> IO ())
receiveReg@(Toggle
toggle,IO a -> IO ()
_),Queue (Toggle, IO a -> IO ())
rest) ->
do
Bool
peek <- Toggle -> IO Bool
peekToggle Toggle
toggle
if Bool
peek
then
Queue (Toggle, IO a -> IO ()) -> IO (Queue (Toggle, IO a -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Toggle, IO a -> IO ())
-> (Toggle, IO a -> IO ()) -> Queue (Toggle, IO a -> IO ())
forall a. Queue a -> a -> Queue a
insertAtEndQ Queue (Toggle, IO a -> IO ())
rest (Toggle, IO a -> IO ())
receiveReg)
else
Queue (Toggle, IO a -> IO ()) -> IO (Queue (Toggle, IO a -> IO ()))
forall a.
Queue (Toggle, IO a -> IO ()) -> IO (Queue (Toggle, IO a -> IO ()))
cleanReceives Queue (Toggle, IO a -> IO ())
rest