-- | This is a bare-bones implementation of CML-style channels, IE no
-- guards.  Why not use NullGuardChannel you might ask?  Because all the
-- gunge we add to do guards makes it too inefficient.
--
-- To avoid memory-leaks we need to clean out superannuated registrations
-- occasionally, as otherwise we will gradually run out of memory if the
-- user continually polls a receive channel event, but no-one is sending
-- anything.  (The memory lost is potentially quite big, since it includes
-- all the continuations we will never need.)
--
-- Although this is not expressed by the type, there are three possible states
-- for the channel
-- (1) we have >=0 queued send events and no queued receive events.
-- (2) we have >=0 queued receive events and no queued send events.
-- (3) we have both send and receive events queued, but they all come
--     from the same synchronisation.
-- When we have a new send event, and there are queued receive events
-- not from the same synchronisation, we can match.  Otherwise the
-- send event must be queued.  For receive events the situation is exactly
-- the same in reverse.
--
-- Our quick and dirty strategy is to maintain an integer counter for the
-- channel.  This is initially 0 and on each send or receive registration
-- changes as follows:
-- 1) If we match an event set counter to 0.
-- 2) If we try to match an event, but fail because the event was already
--    matched by someone else (Anticipated), leave counter as it is.
-- 3) If finally we have to queue an event, look at counter.  If it
--    exceeds 10, clean the queue and set counter to 0, otherwise increment it.
-- \"cleaning\" means removing all items from the front of the queue which
-- have flipped toggles.
module Events.Channels(
   Channel,
   newChannel, -- :: IO Channel a
   -- A Channel is an instance of HasSend and HasReceive.
   ) where

import Control.Concurrent

import Util.Computation(done)
import Util.Queue


import Events.Toggle
import Events.Events

-- | A synchronous channel
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 -- this is how high the counter has to get before we clean.
cleanPar :: Int
cleanPar = Int
10

-- | Create a new channel
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