From 3a2775bc5bd132109c8cfbd84b11a1e7cf633311 Mon Sep 17 00:00:00 2001
From: tv <tv@shackspace.de>
Date: Sat, 17 Oct 2015 19:21:45 +0200
Subject: MSampleVarX: take with takeSV and read with readSV
---
Control/Concurrent/MSampleVarX.hs | 18 ++++++++++++------
1 file changed, 12 insertions(+), 6 deletions(-)
(limited to 'Control/Concurrent/MSampleVarX.hs')
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.
--
--
cgit v1.2.3