[commit: stm] master: Add TSem, bump version to 2.4.2 (c3bbe6c)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/stm

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/c3bbe6c4465c16161f5f0d922411f8c5079a0c5c

>---------------------------------------------------------------

commit c3bbe6c4465c16161f5f0d922411f8c5079a0c5c
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Fri Nov 16 21:48:12 2012 +0000

    Add TSem, bump version to 2.4.2

>---------------------------------------------------------------

 Control/Concurrent/STM/TSem.hs |   54 ++++++++++++++++++++++++++++++++++++++++
 stm.cabal                      |    7 ++++-
 2 files changed, 60 insertions(+), 1 deletions(-)

diff --git a/Control/Concurrent/STM/TSem.hs b/Control/Concurrent/STM/TSem.hs
new file mode 100644
index 0000000..ed655cc
--- /dev/null
+++ b/Control/Concurrent/STM/TSem.hs
@@ -0,0 +1,54 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Concurrent.STM.TSem
+-- Copyright   :  (c) The University of Glasgow 2012
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries at haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (requires STM)
+--
+-- 'TSem': transactional semaphores.
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE DeriveDataTypeable #-}
+module Control.Concurrent.STM.TSem (
+      TSem, newTSem, waitTSem, signalTSem
+  ) where
+
+import Control.Concurrent.STM
+import Control.Monad
+import Data.Typeable
+import Control.Exception
+
+-- | 'TSem' is a transactional semaphore.  It holds a certain number
+-- of units, and units may be acquired or released by 'waitTSem' and
+-- 'signalTSem' respectively.  When the 'TSem' is empty, 'waitTSem'
+-- blocks.
+--
+-- Note that 'TSem' has no concept of fairness, and there is no
+-- guarantee that threads blocked in `waitTSem` will be unblocked in
+-- the same order; in fact they will all be unblocked at the same time
+-- and will fight over the 'TSem'.  Hence 'TSem' is not suitable if
+-- you expect there to be a high number of threads contending for the
+-- resource.  However, like other STM abstractions, 'TSem' is
+-- composable.
+--
+newtype TSem = TSem (TVar Int)
+  deriving (Eq, Typeable)
+
+newTSem :: Int -> STM TSem
+newTSem i = fmap TSem (newTVar i)
+
+waitTSem :: TSem -> STM ()
+waitTSem (TSem t) = do
+  i <- readTVar t
+  when (i <= 0) retry
+  writeTVar t $! (i-1)
+
+signalTSem :: TSem -> STM ()
+signalTSem (TSem t) = do
+  i <- readTVar t
+  writeTVar t $! i+1
+
diff --git a/stm.cabal b/stm.cabal
index 2657e23..2467be3 100644
--- a/stm.cabal
+++ b/stm.cabal
@@ -1,5 +1,5 @@
 name:		stm
-version:        2.4.1
+version:        2.4.2
 license:	BSD3
 license-file:	LICENSE
 maintainer:	libraries at haskell.org
@@ -8,6 +8,10 @@ category:       Concurrency
 description:
  A modular composable concurrency abstraction.
  .
+ Changes in version 2.4.2
+ .
+ * Added "Control.Concurrent.STM.TSem" (transactional semaphore)
+ .
  Changes in version 2.4.1
  .
  * Added Applicative/Alternative instances of STM for GHC <7.0
@@ -44,6 +48,7 @@ library
     Control.Concurrent.STM.TMVar
     Control.Concurrent.STM.TQueue
     Control.Concurrent.STM.TBQueue
+    Control.Concurrent.STM.TSem
     Control.Monad.STM
   other-modules:
     Control.Sequential.STM