stm 2.4.4.1 → 2.4.5.0

raw patch · 11 files changed

+162/−31 lines, 11 filesdep ~base

Dependency ranges changed: base

Files

• Control/Concurrent/STM.hs +3/−3
• Control/Concurrent/STM/TBQueue.hs +22/−5
• Control/Concurrent/STM/TChan.hs +6/−0
• Control/Concurrent/STM/TMVar.hs +2/−0
• Control/Concurrent/STM/TQueue.hs +26/−10
• Control/Concurrent/STM/TSem.hs +57/−5
• Control/Concurrent/STM/TVar.hs +6/−0
• Control/Monad/STM.hs +9/−3
• Control/Sequential/STM.hs +2/−0
• changelog.md +15/−0
• stm.cabal +14/−5

@@ -20,9 +20,9 @@ -- abstraction.  See -- --  * /Composable memory transactions/, by Tim Harris, Simon Marlow, Simon---    Peyton Jones, and Maurice Herlihy, in /ACM Conference on Principles---    and Practice of Parallel Programming/ 2005.---    <http://research.microsoft.com/Users/simonpj/papers/stm/index.htm>+--    Peyton Jones, and Maurice Herlihy, in+--    /ACM Conference on Principles and Practice of Parallel Programming/ 2005.+--    <https://www.microsoft.com/en-us/research/publication/composable-memory-transactions/> -- ----------------------------------------------------------------------------- 

@@ -34,6 +34,7 @@         newTBQueueIO,         readTBQueue,         tryReadTBQueue,+        flushTBQueue,         peekTBQueue,         tryPeekTBQueue,         writeTBQueue,@@ -101,12 +102,12 @@ writeTBQueue (TBQueue rsize _read wsize write) a = do   w <- readTVar wsize   if (w /= 0)-     then do writeTVar wsize (w - 1)+     then do writeTVar wsize $! w - 1      else do           r <- readTVar rsize           if (r /= 0)              then do writeTVar rsize 0-                     writeTVar wsize (r - 1)+                     writeTVar wsize $! r - 1              else retry   listend <- readTVar write   writeTVar write (a:listend)@@ -116,7 +117,7 @@ readTBQueue (TBQueue rsize read _wsize write) = do   xs <- readTVar read   r <- readTVar rsize-  writeTVar rsize (r + 1)+  writeTVar rsize $! r + 1   case xs of     (x:xs') -> do       writeTVar read xs'@@ -137,6 +138,22 @@ tryReadTBQueue :: TBQueue a -> STM (Maybe a) tryReadTBQueue c = fmap Just (readTBQueue c) `orElse` return Nothing +-- | Efficiently read the entire contents of a 'TBQueue' into a list. This+-- function never retries.+--+-- @since 2.4.5+flushTBQueue :: TBQueue a -> STM [a]+flushTBQueue (TBQueue rsize read wsize write) = do+  xs <- readTVar read+  ys <- readTVar write+  r <- readTVar rsize+  w <- readTVar wsize+  writeTVar read []+  writeTVar write []+  writeTVar rsize 0+  writeTVar wsize (r + w)+  return (xs ++ reverse ys)+ -- | Get the next value from the @TBQueue@ without removing it, -- retrying if the channel is empty. peekTBQueue :: TBQueue a -> STM a@@ -162,11 +179,11 @@ unGetTBQueue (TBQueue rsize read wsize _write) a = do   r <- readTVar rsize   if (r > 0)-     then do writeTVar rsize (r - 1)+     then do writeTVar rsize $! r - 1      else do           w <- readTVar wsize           if (w > 0)-             then writeTVar wsize (w - 1)+             then writeTVar wsize $! w - 1              else retry   xs <- readTVar read   writeTVar read (a:xs)

@@ -135,6 +135,8 @@  -- | A version of 'readTChan' which does not retry. Instead it -- returns @Nothing@ if no value is available.+--+-- @since 2.3 tryReadTChan :: TChan a -> STM (Maybe a) tryReadTChan (TChan read _write) = do   listhead <- readTVar read@@ -147,6 +149,8 @@  -- | Get the next value from the @TChan@ without removing it, -- retrying if the channel is empty.+--+-- @since 2.3 peekTChan :: TChan a -> STM a peekTChan (TChan read _write) = do   listhead <- readTVar read@@ -157,6 +161,8 @@  -- | A version of 'peekTChan' which does not retry. Instead it -- returns @Nothing@ if no value is available.+--+-- @since 2.3 tryPeekTChan :: TChan a -> STM (Maybe a) tryPeekTChan (TChan read _write) = do   listhead <- readTVar read

@@ -135,6 +135,8 @@  -- | 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 t) = readTVar t 

@@ -38,6 +38,7 @@         newTQueueIO,         readTQueue,         tryReadTQueue,+        flushTQueue,         peekTQueue,         tryPeekTQueue,         writeTQueue,@@ -87,21 +88,36 @@ readTQueue (TQueue read write) = do   xs <- readTVar read   case xs of-    (x:xs') -> do writeTVar read xs'-                  return x-    [] -> do ys <- readTVar write-             case ys of-               [] -> retry-               _  -> case reverse ys of-                       [] -> error "readTQueue"-                       (z:zs) -> do writeTVar write []-                                    writeTVar read zs-                                    return z+    (x:xs') -> do+      writeTVar read xs'+      return x+    [] -> do+      ys <- readTVar write+      case ys of+        [] -> retry+        _  -> do+          let (z:zs) = reverse ys -- NB. lazy: we want the transaction to be+                                  -- short, otherwise it will conflict+          writeTVar write []+          writeTVar read zs+          return z  -- | A version of 'readTQueue' which does not retry. Instead it -- returns @Nothing@ if no value is available. tryReadTQueue :: TQueue a -> STM (Maybe a) tryReadTQueue c = fmap Just (readTQueue c) `orElse` return Nothing++-- | Efficiently read the entire contents of a 'TQueue' into a list. This+-- function never retries.+--+-- @since 2.4.5+flushTQueue :: TQueue a -> STM [a]+flushTQueue (TQueue read write) = do+  xs <- readTVar read+  ys <- readTVar write+  writeTVar read []+  writeTVar write []+  return (xs ++ reverse ys)  -- | Get the next value from the @TQueue@ without removing it, -- retrying if the channel is empty.

@@ -3,7 +3,7 @@ -- 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)@@ -14,13 +14,20 @@ -----------------------------------------------------------------------------  {-# LANGUAGE DeriveDataTypeable #-}-module Control.Concurrent.STM.TSem (-      TSem, newTSem, waitTSem, signalTSem+module Control.Concurrent.STM.TSem+  ( TSem+  , newTSem++  , waitTSem++  , signalTSem+  , signalTSemN   ) where  import Control.Concurrent.STM import Control.Monad import Data.Typeable+import Data.Word as Word  -- | 'TSem' is a transactional semaphore.  It holds a certain number -- of units, and units may be acquired or released by 'waitTSem' and@@ -36,20 +43,65 @@ -- composable. -- -- @since 2.4.2-newtype TSem = TSem (TVar Int)+newtype TSem = TSem (TVar Integer)   deriving (Eq, Typeable) +-- | Construct new 'TSem' with an initial counter value.+--+-- A positive initial counter value denotes availability of+-- units 'waitTSem' can acquire.+--+-- The initial counter value can be negative which denotes a resource+-- \"debt\" that requires a respective amount of 'signalTSem'+-- operations to counter-balance.+--+-- @since 2.4.2 newTSem :: Int -> STM TSem-newTSem i = fmap TSem (newTVar i)+newTSem i = fmap TSem (newTVar $! toInteger i) +-- NOTE: we can't expose a good `TSem -> STM Int' operation as blocked+-- 'waitTSem' aren't reliably reflected in a negative counter value.++-- | Wait on 'TSem' (aka __P__ operation).+--+-- This operation acquires a unit from the semaphore (i.e. decreases+-- the internal counter) and blocks (via 'retry') if no units are+-- available (i.e. if the counter is /not/ positive).+--+-- @since 2.4.2 waitTSem :: TSem -> STM () waitTSem (TSem t) = do   i <- readTVar t   when (i <= 0) retry   writeTVar t $! (i-1) ++-- Alternatively, the implementation could block (via 'retry') when+-- the next increment would overflow, i.e. testing for 'maxBound'++-- | Signal a 'TSem' (aka __V__ operation).+--+-- This operation adds\/releases a unit back to the semaphore+-- (i.e. increments the internal counter).+--+-- @since 2.4.2 signalTSem :: TSem -> STM () signalTSem (TSem t) = do   i <- readTVar t   writeTVar t $! i+1 ++-- | Multi-signal a 'TSem'+--+-- This operation adds\/releases multiple units back to the semaphore+-- (i.e. increments the internal counter).+--+-- > signalTSem == signalTSemN 1+--+-- @since 2.4.5+signalTSemN :: Word.Word -> TSem -> STM ()+signalTSemN 0 _ = return ()+signalTSemN 1 s = signalTSem s+signalTSemN n (TSem t) = do+  i <- readTVar t+  writeTVar t $! i+(toInteger n)

@@ -46,6 +46,8 @@ -- Like 'modifyIORef' but for 'TVar'. -- | Mutate the contents of a 'TVar'. /N.B./, this version is -- non-strict.+--+-- @since 2.3 modifyTVar :: TVar a -> (a -> a) -> STM () modifyTVar var f = do     x <- readTVar var@@ -54,6 +56,8 @@   -- | Strict version of 'modifyTVar'.+--+-- @since 2.3 modifyTVar' :: TVar a -> (a -> a) -> STM () modifyTVar' var f = do     x <- readTVar var@@ -63,6 +67,8 @@  -- Like 'swapTMVar' but for 'TVar'. -- | Swap the contents of a 'TVar' for a new value.+--+-- @since 2.3 swapTVar :: TVar a -> a -> STM a swapTVar var new = do     old <- readTVar var

@@ -19,9 +19,9 @@ -- abstraction.  See -- --  * /Composable memory transactions/, by Tim Harris, Simon Marlow, Simon---    Peyton Jones, and Maurice Herlihy, in /ACM Conference on Principles---    and Practice of Parallel Programming/ 2005.---    <http://research.microsoft.com/Users/simonpj/papers/stm/index.htm>+--    Peyton Jones, and Maurice Herlihy, in+--    /ACM Conference on Principles and Practice of Parallel Programming/ 2005.+--    <https://www.microsoft.com/en-us/research/publication/composable-memory-transactions/> -- -- This module only defines the 'STM' monad; you probably want to -- import "Control.Concurrent.STM" (which exports "Control.Monad.STM").@@ -78,6 +78,11 @@   (<|>) = orElse #endif +-- | Check that the boolean condition is true and, if not, 'retry'.+--+-- In other words, @check b = unless b retry@.+--+-- @since 2.1.1 check :: Bool -> STM () check b = if b then return () else retry #endif@@ -119,6 +124,7 @@ liftSTM :: STM a -> State# RealWorld -> STMret a liftSTM (STM m) = \s -> case m s of (# s', r #) -> STMret s' r +-- | @since 2.3 instance MonadFix STM where   mfix k = STM $ \s ->     let ans        = liftSTM (k r) s

@@ -51,6 +51,7 @@         rollback <- readIORef r         rollback +-- | @since 2.2.0 throwSTM :: Exception e => e -> STM a throwSTM = STM . const . throwIO @@ -83,6 +84,7 @@ readTVar :: TVar a -> STM a readTVar (TVar ref) = STM (const (readIORef ref)) +-- | @since 2.1.2 readTVarIO :: TVar a -> IO a readTVarIO (TVar ref) = readIORef ref 

@@ -1,5 +1,20 @@ # Changelog for [`stm` package](http://hackage.haskell.org/package/stm) +## 2.4.5.0 *Feb 2018*++  * Fix space leak in `TBQueue` (gh-2, GHC#14494)++  * Make `signalTSem` resilient against `Int` overflows (gh-4)++  * Make definition of `readTQueue` consistent with `readTBQueue` (gh-3, GHC#9539)++  * Add `flushTQueue` to `Control.Concurrent.STM.TQueue` (gh-1)++  * Add `flushTBQueue` to `Control.Concurrent.STM.TBQueue` (gh-1)++  * Add `signalTSemN` operation (gh-5)++ ## 2.4.4.1  *Dec 2015*    * Add support for `base-4.9.0.0`

@@ -1,23 +1,32 @@ name:           stm-version:        2.4.4.1+version:        2.4.5.0 -- don't forget to update changelog.md file! license:        BSD3 license-file:   LICENSE maintainer:     libraries@haskell.org-bug-reports:    https://ghc.haskell.org/trac/ghc/newticket?component=libraries%20%28other%29&keywords=stm+homepage:       https://wiki.haskell.org/Software_transactional_memory+bug-reports:    https://github.com/haskell/stm/issues synopsis:       Software Transactional Memory category:       Concurrency-description:    A modular composable concurrency abstraction. build-type:     Simple cabal-version:  >=1.10 tested-with:    GHC==7.10.*, GHC==7.8.*, GHC==7.6.*, GHC==7.4.*, GHC==7.2.*, GHC==7.0.*+description:+    Software Transactional Memory, or STM, is an abstraction for+    concurrent communication. The main benefits of STM are+    /composability/ and /modularity/. That is, using STM you can write+    concurrent abstractions that can be easily composed with any other+    abstraction built using STM, without exposing the details of how+    your abstraction ensures safety. This is typically not the case+    with other forms of concurrent communication, such as locks or+    'MVar's.  extra-source-files:     changelog.md  source-repository head     type:     git-    location: http://git.haskell.org/packages/stm.git+    location: https://github.com/haskell/stm.git  library     default-language: Haskell2010@@ -34,7 +43,7 @@         other-extensions: Safe      build-depends:-        base  >= 4.3 && < 4.10,+        base  >= 4.3 && < 4.12,         array >= 0.3 && < 0.6      exposed-modules: