diff options
Diffstat (limited to 'Control')
-rw-r--r-- | Control/Concurrent/MSampleVarX.hs | 18 |
1 files changed, 12 insertions, 6 deletions
diff --git a/Control/Concurrent/MSampleVarX.hs b/Control/Concurrent/MSampleVarX.hs index 578d391..88256f5 100644 --- a/Control/Concurrent/MSampleVarX.hs +++ b/Control/Concurrent/MSampleVarX.hs @@ -16,19 +16,20 @@ -- cause 'writeSampleVar' to hang. The 'MSampleVar' in this module is immune -- to this error, and has a simpler implementation. -- -module Control.Concurrent.MSampleVar +module Control.Concurrent.MSampleVarX ( -- * Sample Variables MSampleVar, newEmptySV, -- :: IO (MSampleVar a) newSV, -- :: a -> IO (MSampleVar a) emptySV, -- :: MSampleVar a -> IO () readSV, -- :: MSampleVar a -> IO a + takeSV, -- :: MSampleVar a -> IO a writeSV, -- :: MSampleVar a -> a -> IO () isEmptySV, -- :: MSampleVar a -> IO Bool ) where import Control.Monad(void,join) -import Control.Concurrent.MVar(MVar,newMVar,newEmptyMVar,tryTakeMVar,takeMVar,putMVar,withMVar,isEmptyMVar) +import Control.Concurrent.MVar(MVar,newMVar,newEmptyMVar,readMVar,tryTakeMVar,takeMVar,putMVar,withMVar,isEmptyMVar) import Control.Exception(mask_) import Data.Typeable @@ -101,7 +102,7 @@ isEmptySV (MSampleVar _ ls) = withMVar ls isEmptyMVar -- (withMVar ls) might block, interrupting is okay -- | If the 'MSampleVar' is full, forget the value and leave it empty. --- Otherwise, do nothing. This avoids any the FIFO queue of blocked 'readSV' +-- Otherwise, do nothing. This avoids any the FIFO queue of blocked 'takeSV' -- threads. -- -- 'emptySV' can block and be interrupted, in which case it does nothing. If @@ -110,18 +111,23 @@ emptySV :: MSampleVar a -> IO () emptySV (MSampleVar _ ls) = withMVar ls (void . tryTakeMVar) -- (withMVar ls) might block, interrupting is okay --- | Wait for a value to become available, then take it and return. The queue +-- | Wait for a value to become available, then read it and return. The queue -- of blocked 'readSV' threads is a fair FIFO queue. -- -- 'readSV' can block and be interrupted, in which case it takes nothing. If --- 'readSV returns normally then it has taken a value. +-- 'readSV' returns normally then it has taken a value. readSV :: MSampleVar a -> IO a readSV (MSampleVar rq ls) = mask_ $ withMVar rq $ \ () -> - join $ withMVar ls (return . takeMVar) + join $ withMVar ls (return . readMVar) -- (withMVar rq) might block, interrupting is okay -- (withMVar ls) might block, interrupting is okay -- join (takeMVar _) will block if empty, interrupting is okay +-- | Similar to 'readSV' but empty the variable after reading it. +takeSV :: MSampleVar a -> IO a +takeSV (MSampleVar rq ls) = mask_ $ withMVar rq $ \ () -> + join $ withMVar ls (return . takeMVar) + -- | Write a value into the 'MSampleVar', overwriting any previous value that -- was there. -- |