diff --git a/Control/Concurrent/STM/TMVar.hs b/Control/Concurrent/STM/TMVar.hs index 69dacab..0e4b24e 100644 --- a/Control/Concurrent/STM/TMVar.hs +++ b/Control/Concurrent/STM/TMVar.hs @@ -32,10 +32,12 @@ module Control.Concurrent.STM.TMVar ( readTMVar, writeTMVar, tryReadTMVar, + tryReadTMVarIO, swapTMVar, tryTakeTMVar, tryPutTMVar, isEmptyTMVar, + isEmptyTMVarIO, mkWeakTMVar #endif ) where @@ -141,6 +143,17 @@ readTMVar (TMVar t) = do tryReadTMVar :: TMVar a -> STM (Maybe a) tryReadTMVar (TMVar t) = readTVar t +-- | A version of 'readTMVar' which does not retry. This is +-- equivalent to +-- +-- > readTVarIO = atomically . readTVar +-- +-- but works much faster, because it doesn't perform a complete +-- transaction, it just attempts to read the current value of +-- the 'TMVar'. +tryReadTMVarIO :: TMVar a -> IO (Maybe a) +tryReadTMVarIO (TMVar t) = readTVarIO t + -- |Swap the contents of a 'TMVar' for a new value. swapTMVar :: TMVar a -> a -> STM a swapTMVar (TMVar t) new = do @@ -164,6 +177,14 @@ isEmptyTMVar (TMVar t) = do Nothing -> return True Just _ -> return False +-- |@IO@ version of 'isEmptyTVar'. +isEmptyTMVarIO :: TMVar a -> IO Bool +isEmptyTMVarIO (TMVar t) = do + m <- readTVarIO t + case m of + Nothing -> return True + Just _ -> return False + -- | Make a 'Weak' pointer to a 'TMVar', using the second argument as -- a finalizer to run when the 'TMVar' is garbage-collected. -- diff --git a/Control/Concurrent/STM/TSem.hs b/Control/Concurrent/STM/TSem.hs index fc14955..9100086 100644 --- a/Control/Concurrent/STM/TSem.hs +++ b/Control/Concurrent/STM/TSem.hs @@ -17,6 +17,7 @@ module Control.Concurrent.STM.TSem ( TSem , newTSem + , newTSemIO , waitTSem @@ -59,6 +60,10 @@ newtype TSem = TSem (TVar Integer) newTSem :: Integer -> STM TSem newTSem i = fmap TSem (newTVar $! i) +-- |@IO@ equivalent of 'newTSem'. +newTSemIO :: Integer -> IO TSem +newTSemIO i = fmap TSem (newTVarIO $! i) + -- NOTE: we can't expose a good `TSem -> STM Int' operation as blocked -- 'waitTSem' aren't reliably reflected in a negative counter value.