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 <[email protected]> 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 : [email protected] +-- 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: [email protected] @@ -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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
