----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.STM.TSem -- Copyright : (c) The University of Glasgow 2012 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@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 -- | '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