{-# LANGUAGE CPP, DeriveDataTypeable #-} #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.STM.TMVar -- Copyright : (c) The University of Glasgow 2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (requires STM) -- -- TMVar: Transactional MVars, for use in the STM monad -- (GHC only) -- ----------------------------------------------------------------------------- module Control.Concurrent.STM.TMVar ( #ifdef __GLASGOW_HASKELL__ -- * TMVars TMVar, newTMVar, newEmptyTMVar, newTMVarIO, newEmptyTMVarIO, takeTMVar, putTMVar, readTMVar, tryReadTMVar, swapTMVar, tryTakeTMVar, tryPutTMVar, isEmptyTMVar #endif ) where #ifdef __GLASGOW_HASKELL__ import GHC.Conc import Data.Typeable (Typeable) newtype TMVar a = TMVar (TVar (Maybe a)) deriving (Eq, Typeable) {- ^ A 'TMVar' is a synchronising variable, used for communication between concurrent threads. It can be thought of as a box, which may be empty or full. -} -- |Create a 'TMVar' which contains the supplied value. newTMVar :: a -> STM (TMVar a) newTMVar a = do t <- newTVar (Just a) return (TMVar t) -- |@IO@ version of 'newTMVar'. This is useful for creating top-level -- 'TMVar's using 'System.IO.Unsafe.unsafePerformIO', because using -- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't -- possible. newTMVarIO :: a -> IO (TMVar a) newTMVarIO a = do t <- newTVarIO (Just a) return (TMVar t) -- |Create a 'TMVar' which is initially empty. newEmptyTMVar :: STM (TMVar a) newEmptyTMVar = do t <- newTVar Nothing return (TMVar t) -- |@IO@ version of 'newEmptyTMVar'. This is useful for creating top-level -- 'TMVar's using 'System.IO.Unsafe.unsafePerformIO', because using -- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't -- possible. newEmptyTMVarIO :: IO (TMVar a) newEmptyTMVarIO = do t <- newTVarIO Nothing return (TMVar t) -- |Return the contents of the 'TMVar'. If the 'TMVar' is currently -- empty, the transaction will 'retry'. After a 'takeTMVar', -- the 'TMVar' is left empty. takeTMVar :: TMVar a -> STM a takeTMVar (TMVar t) = do m <- readTVar t case m of Nothing -> retry Just a -> do writeTVar t Nothing; return a -- | A version of 'takeTMVar' that does not 'retry'. The 'tryTakeTMVar' -- function returns 'Nothing' if the 'TMVar' was empty, or @'Just' a@ if -- the 'TMVar' was full with contents @a@. After 'tryTakeTMVar', the -- 'TMVar' is left empty. tryTakeTMVar :: TMVar a -> STM (Maybe a) tryTakeTMVar (TMVar t) = do m <- readTVar t case m of Nothing -> return Nothing Just a -> do writeTVar t Nothing; return (Just a) -- |Put a value into a 'TMVar'. If the 'TMVar' is currently full, -- 'putTMVar' will 'retry'. putTMVar :: TMVar a -> a -> STM () putTMVar (TMVar t) a = do m <- readTVar t case m of Nothing -> do writeTVar t (Just a); return () Just _ -> retry -- | A version of 'putTMVar' that does not 'retry'. The 'tryPutTMVar' -- function attempts to put the value @a@ into the 'TMVar', returning -- 'True' if it was successful, or 'False' otherwise. tryPutTMVar :: TMVar a -> a -> STM Bool tryPutTMVar (TMVar t) a = do m <- readTVar t case m of Nothing -> do writeTVar t (Just a); return True Just _ -> return False -- | This is a combination of 'takeTMVar' and 'putTMVar'; ie. it -- takes the value from the 'TMVar', puts it back, and also returns -- it. readTMVar :: TMVar a -> STM a readTMVar (TMVar t) = do m <- readTVar t case m of Nothing -> retry Just a -> return a -- | A version of 'readTMVar' which does not retry. Instead it -- returns @Nothing@ if no value is available. tryReadTMVar :: TMVar a -> STM (Maybe a) tryReadTMVar (TMVar t) = readTVar t -- |Swap the contents of a 'TMVar' for a new value. swapTMVar :: TMVar a -> a -> STM a swapTMVar (TMVar t) new = do m <- readTVar t case m of Nothing -> retry Just old -> do writeTVar t (Just new); return old -- |Check whether a given 'TMVar' is empty. isEmptyTMVar :: TMVar a -> STM Bool isEmptyTMVar (TMVar t) = do m <- readTVar t case m of Nothing -> return True Just _ -> return False #endif