{-# LANGUAGE CPP, DeriveDataTypeable, MagicHash, UnboxedTuples #-} #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, writeTMVar, tryReadTMVar, swapTMVar, tryTakeTMVar, tryPutTMVar, isEmptyTMVar, mkWeakTMVar #endif ) where #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.Conc import GHC.Weak import Data.Typeable (Typeable) newtype TMVar a = TMVar (TVar (Maybe a)) deriving (TMVar a -> TMVar a -> Bool (TMVar a -> TMVar a -> Bool) -> (TMVar a -> TMVar a -> Bool) -> Eq (TMVar a) forall a. TMVar a -> TMVar a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: TMVar a -> TMVar a -> Bool $c/= :: forall a. TMVar a -> TMVar a -> Bool == :: TMVar a -> TMVar a -> Bool $c== :: forall a. TMVar a -> TMVar a -> Bool 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 -> STM (TMVar a) newTMVar a a = do TVar (Maybe a) t <- Maybe a -> STM (TVar (Maybe a)) forall a. a -> STM (TVar a) newTVar (a -> Maybe a forall a. a -> Maybe a Just a a) TMVar a -> STM (TMVar a) forall (m :: * -> *) a. Monad m => a -> m a return (TVar (Maybe a) -> TMVar a forall a. TVar (Maybe a) -> TMVar a TMVar TVar (Maybe a) 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 -> IO (TMVar a) newTMVarIO a a = do TVar (Maybe a) t <- Maybe a -> IO (TVar (Maybe a)) forall a. a -> IO (TVar a) newTVarIO (a -> Maybe a forall a. a -> Maybe a Just a a) TMVar a -> IO (TMVar a) forall (m :: * -> *) a. Monad m => a -> m a return (TVar (Maybe a) -> TMVar a forall a. TVar (Maybe a) -> TMVar a TMVar TVar (Maybe a) t) -- |Create a 'TMVar' which is initially empty. newEmptyTMVar :: STM (TMVar a) newEmptyTMVar :: STM (TMVar a) newEmptyTMVar = do TVar (Maybe a) t <- Maybe a -> STM (TVar (Maybe a)) forall a. a -> STM (TVar a) newTVar Maybe a forall a. Maybe a Nothing TMVar a -> STM (TMVar a) forall (m :: * -> *) a. Monad m => a -> m a return (TVar (Maybe a) -> TMVar a forall a. TVar (Maybe a) -> TMVar a TMVar TVar (Maybe a) 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 :: IO (TMVar a) newEmptyTMVarIO = do TVar (Maybe a) t <- Maybe a -> IO (TVar (Maybe a)) forall a. a -> IO (TVar a) newTVarIO Maybe a forall a. Maybe a Nothing TMVar a -> IO (TMVar a) forall (m :: * -> *) a. Monad m => a -> m a return (TVar (Maybe a) -> TMVar a forall a. TVar (Maybe a) -> TMVar a TMVar TVar (Maybe a) 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 a -> STM a takeTMVar (TMVar TVar (Maybe a) t) = do Maybe a m <- TVar (Maybe a) -> STM (Maybe a) forall a. TVar a -> STM a readTVar TVar (Maybe a) t case Maybe a m of Maybe a Nothing -> STM a forall a. STM a retry Just a a -> do TVar (Maybe a) -> Maybe a -> STM () forall a. TVar a -> a -> STM () writeTVar TVar (Maybe a) t Maybe a forall a. Maybe a Nothing; a -> STM a forall (m :: * -> *) a. Monad m => a -> m a return a 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 a -> STM (Maybe a) tryTakeTMVar (TMVar TVar (Maybe a) t) = do Maybe a m <- TVar (Maybe a) -> STM (Maybe a) forall a. TVar a -> STM a readTVar TVar (Maybe a) t case Maybe a m of Maybe a Nothing -> Maybe a -> STM (Maybe a) forall (m :: * -> *) a. Monad m => a -> m a return Maybe a forall a. Maybe a Nothing Just a a -> do TVar (Maybe a) -> Maybe a -> STM () forall a. TVar a -> a -> STM () writeTVar TVar (Maybe a) t Maybe a forall a. Maybe a Nothing; Maybe a -> STM (Maybe a) forall (m :: * -> *) a. Monad m => a -> m a return (a -> Maybe a forall a. a -> Maybe a Just a a) -- |Put a value into a 'TMVar'. If the 'TMVar' is currently full, -- 'putTMVar' will 'retry'. putTMVar :: TMVar a -> a -> STM () putTMVar :: TMVar a -> a -> STM () putTMVar (TMVar TVar (Maybe a) t) a a = do Maybe a m <- TVar (Maybe a) -> STM (Maybe a) forall a. TVar a -> STM a readTVar TVar (Maybe a) t case Maybe a m of Maybe a Nothing -> do TVar (Maybe a) -> Maybe a -> STM () forall a. TVar a -> a -> STM () writeTVar TVar (Maybe a) t (a -> Maybe a forall a. a -> Maybe a Just a a); () -> STM () forall (m :: * -> *) a. Monad m => a -> m a return () Just a _ -> STM () forall a. STM a 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 a -> a -> STM Bool tryPutTMVar (TMVar TVar (Maybe a) t) a a = do Maybe a m <- TVar (Maybe a) -> STM (Maybe a) forall a. TVar a -> STM a readTVar TVar (Maybe a) t case Maybe a m of Maybe a Nothing -> do TVar (Maybe a) -> Maybe a -> STM () forall a. TVar a -> a -> STM () writeTVar TVar (Maybe a) t (a -> Maybe a forall a. a -> Maybe a Just a a); Bool -> STM Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool True Just a _ -> Bool -> STM Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool 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 a -> STM a readTMVar (TMVar TVar (Maybe a) t) = do Maybe a m <- TVar (Maybe a) -> STM (Maybe a) forall a. TVar a -> STM a readTVar TVar (Maybe a) t case Maybe a m of Maybe a Nothing -> STM a forall a. STM a retry Just a a -> a -> STM a forall (m :: * -> *) a. Monad m => a -> m a return a a -- | A version of 'readTMVar' which does not retry. Instead it -- returns @Nothing@ if no value is available. -- -- @since 2.3 tryReadTMVar :: TMVar a -> STM (Maybe a) tryReadTMVar :: TMVar a -> STM (Maybe a) tryReadTMVar (TMVar TVar (Maybe a) t) = TVar (Maybe a) -> STM (Maybe a) forall a. TVar a -> STM a readTVar TVar (Maybe a) t -- |Swap the contents of a 'TMVar' for a new value. swapTMVar :: TMVar a -> a -> STM a swapTMVar :: TMVar a -> a -> STM a swapTMVar (TMVar TVar (Maybe a) t) a new = do Maybe a m <- TVar (Maybe a) -> STM (Maybe a) forall a. TVar a -> STM a readTVar TVar (Maybe a) t case Maybe a m of Maybe a Nothing -> STM a forall a. STM a retry Just a old -> do TVar (Maybe a) -> Maybe a -> STM () forall a. TVar a -> a -> STM () writeTVar TVar (Maybe a) t (a -> Maybe a forall a. a -> Maybe a Just a new); a -> STM a forall (m :: * -> *) a. Monad m => a -> m a return a old -- | Non-blocking write of a new value to a 'TMVar' -- Puts if empty. Replaces if populated. writeTMVar :: TMVar a -> a -> STM () writeTMVar :: TMVar a -> a -> STM () writeTMVar TMVar a t a new = TMVar a -> STM (Maybe a) forall a. TMVar a -> STM (Maybe a) tryTakeTMVar TMVar a t STM (Maybe a) -> STM () -> STM () forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> TMVar a -> a -> STM () forall a. TMVar a -> a -> STM () putTMVar TMVar a t a new -- |Check whether a given 'TMVar' is empty. isEmptyTMVar :: TMVar a -> STM Bool isEmptyTMVar :: TMVar a -> STM Bool isEmptyTMVar (TMVar TVar (Maybe a) t) = do Maybe a m <- TVar (Maybe a) -> STM (Maybe a) forall a. TVar a -> STM a readTVar TVar (Maybe a) t case Maybe a m of Maybe a Nothing -> Bool -> STM Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool True Just a _ -> Bool -> STM Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool False -- | Make a 'Weak' pointer to a 'TMVar', using the second argument as -- a finalizer to run when the 'TMVar' is garbage-collected. -- -- @since 2.4.4 mkWeakTMVar :: TMVar a -> IO () -> IO (Weak (TMVar a)) mkWeakTMVar :: TMVar a -> IO () -> IO (Weak (TMVar a)) mkWeakTMVar tmv :: TMVar a tmv@(TMVar (TVar TVar# RealWorld (Maybe a) t#)) (IO State# RealWorld -> (# State# RealWorld, () #) finalizer) = (State# RealWorld -> (# State# RealWorld, Weak (TMVar a) #)) -> IO (Weak (TMVar a)) forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, Weak (TMVar a) #)) -> IO (Weak (TMVar a))) -> (State# RealWorld -> (# State# RealWorld, Weak (TMVar a) #)) -> IO (Weak (TMVar a)) forall a b. (a -> b) -> a -> b $ \State# RealWorld s -> case TVar# RealWorld (Maybe a) -> TMVar a -> (State# RealWorld -> (# State# RealWorld, () #)) -> State# RealWorld -> (# State# RealWorld, Weak# (TMVar a) #) forall a b c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #) mkWeak# TVar# RealWorld (Maybe a) t# TMVar a tmv State# RealWorld -> (# State# RealWorld, () #) finalizer State# RealWorld s of (# State# RealWorld s1, Weak# (TMVar a) w #) -> (# State# RealWorld s1, Weak# (TMVar a) -> Weak (TMVar a) forall v. Weak# v -> Weak v Weak Weak# (TMVar a) w #) #endif