Implement `signalTSemN` & `waitTSemN` operations
authorHerbert Valerio Riedel <hvr@gnu.org>
Thu, 28 Dec 2017 09:26:16 +0000 (10:26 +0100)
committerHerbert Valerio Riedel <hvr@gnu.org>
Sat, 3 Feb 2018 17:53:40 +0000 (18:53 +0100)
These new operations allow to acquire/release a non-negative amount of
units to the semaphore.

Control/Concurrent/STM/TSem.hs
changelog.md

index 8e4ca25..7e1c58c 100644 (file)
 -----------------------------------------------------------------------------
 
 {-# LANGUAGE DeriveDataTypeable #-}
-module Control.Concurrent.STM.TSem (
-      TSem, newTSem, waitTSem, signalTSem
+module Control.Concurrent.STM.TSem
+  ( TSem
+  , newTSem
+
+  , waitTSem
+  , waitTSemN
+
+  , signalTSem
+  , signalTSemN
   ) where
 
 import Control.Concurrent.STM
 import Control.Monad
 import Data.Typeable
+import Data.Word as Word
 
 -- | 'TSem' is a transactional semaphore.  It holds a certain number
 -- of units, and units may be acquired or released by 'waitTSem' and
@@ -55,9 +63,6 @@ newTSem i = fmap TSem (newTVar $! toInteger i)
 -- NOTE: we can't expose a good `TSem -> STM Int' operation as blocked
 -- 'waitTSem' aren't reliably reflected in a negative counter value.
 
--- TODO: Consider adding '{wait,signal}TSemN :: Word -> TSem -> STM ()'
--- variants; NB: 'waitTSemN 0' would *not* be a no-op
-
 -- | Wait on 'TSem' (aka __P__ operation).
 --
 -- This operation acquires a unit from the semaphore (i.e. decreases
@@ -72,6 +77,29 @@ waitTSem (TSem t) = do
   writeTVar t $! (i-1)
 
 
+-- | Multi-wait on 'TSem'.
+--
+-- Acquire multiple units at once from semaphore; blocks (via 'retry')
+-- when the number of available units is less than the requested
+-- amount.
+--
+-- > waitTSem == waitTSemN 1
+--
+-- __NOTE__: This operation is subtly different from repeatedly
+-- invoking 'waitTSem'. Note that 'waitTSem 0' can block.
+--
+-- @since TBD
+waitTSemN :: Word.Word -> TSem -> STM ()
+waitTSemN 0 (TSem t) = do
+  i <- readTVar t
+  when (i < 0) retry
+waitTSemN 1 s = waitTSem s
+waitTSemN n (TSem t) = do
+  i <- readTVar t
+  let n' = toInteger n
+  when (i < n') retry
+  writeTVar t $! (i-n')
+
 -- Alternatively, the implementation could block (via 'retry') when
 -- the next increment would overflow, i.e. testing for 'maxBound'
 
@@ -85,3 +113,19 @@ signalTSem :: TSem -> STM ()
 signalTSem (TSem t) = do
   i <- readTVar t
   writeTVar t $! i+1
+
+
+-- | Multi-signal a 'TSem'
+--
+-- This operation adds\/releases multiple units back to the semaphore
+-- (i.e. increments the internal counter).
+--
+-- > signalTSem == signalTSemN 1
+--
+-- @since TBD
+signalTSemN :: Word.Word -> TSem -> STM ()
+signalTSemN 0 _ = return ()
+signalTSemN 1 s = signalTSem s
+signalTSemN n (TSem t) = do
+  i <- readTVar t
+  writeTVar t $! i+(toInteger n)
index 1b6714f..6dabeca 100644 (file)
@@ -12,6 +12,8 @@
 
   * Add `flushTBQueue` to `Control.Concurrent.STM.TBQueue` (gh-1)
 
+  * Add `signalTSemN` & `waitTSemN` operations (gh-5)
+
 
 ## 2.4.4.1  *Dec 2015*