diff --git a/Control/Concurrent/STM.hs b/Control/Concurrent/STM.hs --- a/Control/Concurrent/STM.hs +++ b/Control/Concurrent/STM.hs @@ -1,6 +1,8 @@ {-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 701 +#if __GLASGOW_HASKELL__ >= 709 +{-# LANGUAGE Safe #-} +#elif __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE Trustworthy #-} #endif @@ -9,7 +11,7 @@ -- Module : Control.Concurrent.STM -- 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) @@ -25,15 +27,15 @@ ----------------------------------------------------------------------------- module Control.Concurrent.STM ( - module Control.Monad.STM, - module Control.Concurrent.STM.TVar, + module Control.Monad.STM, + module Control.Concurrent.STM.TVar, #ifdef __GLASGOW_HASKELL__ - module Control.Concurrent.STM.TMVar, + module Control.Concurrent.STM.TMVar, module Control.Concurrent.STM.TChan, module Control.Concurrent.STM.TQueue, module Control.Concurrent.STM.TBQueue, #endif - module Control.Concurrent.STM.TArray + module Control.Concurrent.STM.TArray ) where import Control.Monad.STM diff --git a/Control/Concurrent/STM/TBQueue.hs b/Control/Concurrent/STM/TBQueue.hs --- a/Control/Concurrent/STM/TBQueue.hs +++ b/Control/Concurrent/STM/TBQueue.hs @@ -10,7 +10,7 @@ -- Module : Control.Concurrent.STM.TBQueue -- 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) @@ -24,18 +24,19 @@ -- queue representation that uses two lists to obtain amortised /O(1)/ -- enqueue and dequeue operations. -- +-- @since 2.4 ----------------------------------------------------------------------------- module Control.Concurrent.STM.TBQueue ( -- * TBQueue - TBQueue, - newTBQueue, - newTBQueueIO, - readTBQueue, - tryReadTBQueue, - peekTBQueue, - tryPeekTBQueue, - writeTBQueue, + TBQueue, + newTBQueue, + newTBQueueIO, + readTBQueue, + tryReadTBQueue, + peekTBQueue, + tryPeekTBQueue, + writeTBQueue, unGetTBQueue, isEmptyTBQueue, isFullTBQueue, @@ -47,6 +48,8 @@ #define _UPK_(x) {-# UNPACK #-} !(x) -- | 'TBQueue' is an abstract type representing a bounded FIFO channel. +-- +-- @since 2.4 data TBQueue a = TBQueue _UPK_(TVar Int) -- CR: read capacity _UPK_(TVar [a]) -- R: elements waiting to be read @@ -180,6 +183,8 @@ _ -> return False -- |Returns 'True' if the supplied 'TBQueue' is full. +-- +-- @since 2.4.3 isFullTBQueue :: TBQueue a -> STM Bool isFullTBQueue (TBQueue rsize _read wsize _write) = do w <- readTVar wsize diff --git a/Control/Concurrent/STM/TChan.hs b/Control/Concurrent/STM/TChan.hs --- a/Control/Concurrent/STM/TChan.hs +++ b/Control/Concurrent/STM/TChan.hs @@ -10,7 +10,7 @@ -- Module : Control.Concurrent.STM.TChan -- 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) @@ -22,23 +22,23 @@ module Control.Concurrent.STM.TChan ( #ifdef __GLASGOW_HASKELL__ - -- * TChans - TChan, + -- * TChans + TChan, -- ** Construction newTChan, - newTChanIO, - newBroadcastTChan, - newBroadcastTChanIO, + newTChanIO, + newBroadcastTChan, + newBroadcastTChanIO, dupTChan, cloneTChan, -- ** Reading and writing - readTChan, - tryReadTChan, - peekTChan, - tryPeekTChan, - writeTChan, + readTChan, + tryReadTChan, + peekTChan, + tryPeekTChan, + writeTChan, unGetTChan, isEmptyTChan #endif @@ -95,6 +95,8 @@ -- it is only written to and never read, items will pile up in memory. By -- using 'newBroadcastTChan' to create the broadcast channel, items can be -- garbage collected after clients have seen them. +-- +-- @since 2.4 newBroadcastTChan :: STM (TChan a) newBroadcastTChan = do write_hole <- newTVar TNil @@ -103,6 +105,8 @@ return (TChan read write) -- | @IO@ version of 'newBroadcastTChan'. +-- +-- @since 2.4 newBroadcastTChanIO :: IO (TChan a) newBroadcastTChanIO = do write_hole <- newTVarIO TNil @@ -126,8 +130,8 @@ case head of TNil -> retry TCons a tail -> do - writeTVar read tail - return a + writeTVar read tail + return a -- | A version of 'readTChan' which does not retry. Instead it -- returns @Nothing@ if no value is available. @@ -167,7 +171,7 @@ -- everyone else. dupTChan :: TChan a -> STM (TChan a) dupTChan (TChan _read write) = do - hole <- readTVar write + hole <- readTVar write new_read <- newTVar hole return (TChan new_read write) @@ -189,6 +193,8 @@ -- |Clone a 'TChan': similar to dupTChan, but the cloned channel starts with the -- same content available as the original channel. +-- +-- @since 2.4 cloneTChan :: TChan a -> STM (TChan a) cloneTChan (TChan read write) = do readpos <- readTVar read diff --git a/Control/Concurrent/STM/TMVar.hs b/Control/Concurrent/STM/TMVar.hs --- a/Control/Concurrent/STM/TMVar.hs +++ b/Control/Concurrent/STM/TMVar.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, DeriveDataTypeable #-} +{-# LANGUAGE CPP, DeriveDataTypeable, MagicHash, UnboxedTuples #-} #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE Trustworthy #-} @@ -9,7 +9,7 @@ -- 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) @@ -21,25 +21,28 @@ module Control.Concurrent.STM.TMVar ( #ifdef __GLASGOW_HASKELL__ - -- * TMVars - TMVar, - newTMVar, - newEmptyTMVar, - newTMVarIO, - newEmptyTMVarIO, - takeTMVar, - putTMVar, - readTMVar, - tryReadTMVar, - swapTMVar, - tryTakeTMVar, - tryPutTMVar, - isEmptyTMVar + -- * TMVars + TMVar, + newTMVar, + newEmptyTMVar, + newTMVarIO, + newEmptyTMVarIO, + takeTMVar, + putTMVar, + readTMVar, + tryReadTMVar, + swapTMVar, + tryTakeTMVar, + tryPutTMVar, + isEmptyTMVar, + mkWeakTMVar #endif ) where #ifdef __GLASGOW_HASKELL__ +import GHC.Base import GHC.Conc +import GHC.Weak import Data.Typeable (Typeable) @@ -81,7 +84,7 @@ return (TMVar t) -- |Return the contents of the 'TMVar'. If the 'TMVar' is currently --- empty, the transaction will 'retry'. After a 'takeTMVar', +-- empty, the transaction will 'retry'. After a 'takeTMVar', -- the 'TMVar' is left empty. takeTMVar :: TMVar a -> STM a takeTMVar (TMVar t) = do @@ -150,4 +153,12 @@ 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. +-- +-- @since 2.4.4 +mkWeakTMVar :: TMVar a -> IO () -> IO (Weak (TMVar a)) +mkWeakTMVar tmv@(TMVar (TVar t#)) f = IO $ \s -> + case mkWeak# t# tmv f s of (# s1, w #) -> (# s1, Weak w #) #endif diff --git a/Control/Concurrent/STM/TQueue.hs b/Control/Concurrent/STM/TQueue.hs --- a/Control/Concurrent/STM/TQueue.hs +++ b/Control/Concurrent/STM/TQueue.hs @@ -10,7 +10,7 @@ -- Module : Control.Concurrent.STM.TQueue -- 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) @@ -28,18 +28,19 @@ -- queue representation that uses two lists to obtain amortised /O(1)/ -- enqueue and dequeue operations. -- +-- @since 2.4 ----------------------------------------------------------------------------- module Control.Concurrent.STM.TQueue ( -- * TQueue - TQueue, - newTQueue, - newTQueueIO, - readTQueue, - tryReadTQueue, - peekTQueue, - tryPeekTQueue, - writeTQueue, + TQueue, + newTQueue, + newTQueueIO, + readTQueue, + tryReadTQueue, + peekTQueue, + tryPeekTQueue, + writeTQueue, unGetTQueue, isEmptyTQueue, ) where @@ -49,6 +50,8 @@ import Data.Typeable (Typeable) -- | 'TQueue' is an abstract type representing an unbounded FIFO channel. +-- +-- @since 2.4 data TQueue a = TQueue {-# UNPACK #-} !(TVar [a]) {-# UNPACK #-} !(TVar [a]) deriving Typeable diff --git a/Control/Concurrent/STM/TSem.hs b/Control/Concurrent/STM/TSem.hs --- a/Control/Concurrent/STM/TSem.hs +++ b/Control/Concurrent/STM/TSem.hs @@ -10,6 +10,7 @@ -- -- 'TSem': transactional semaphores. -- +-- @since 2.4.2 ----------------------------------------------------------------------------- {-# LANGUAGE DeriveDataTypeable #-} @@ -34,6 +35,7 @@ -- resource. However, like other STM abstractions, 'TSem' is -- composable. -- +-- @since 2.4.2 newtype TSem = TSem (TVar Int) deriving (Eq, Typeable) diff --git a/Control/Concurrent/STM/TVar.hs b/Control/Concurrent/STM/TVar.hs --- a/Control/Concurrent/STM/TVar.hs +++ b/Control/Concurrent/STM/TVar.hs @@ -9,7 +9,7 @@ -- Module : Control.Concurrent.STM.TVar -- 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) @@ -19,16 +19,16 @@ ----------------------------------------------------------------------------- module Control.Concurrent.STM.TVar ( - -- * TVars - TVar, - newTVar, - newTVarIO, - readTVar, - readTVarIO, - writeTVar, - modifyTVar, - modifyTVar', - swapTVar, + -- * TVars + TVar, + newTVar, + newTVarIO, + readTVar, + readTVarIO, + writeTVar, + modifyTVar, + modifyTVar', + swapTVar, #ifdef __GLASGOW_HASKELL__ registerDelay, #endif @@ -73,6 +73,8 @@ -- | Make a 'Weak' pointer to a 'TVar', using the second argument as -- a finalizer to run when 'TVar' is garbage-collected +-- +-- @since 2.4.3 mkWeakTVar :: TVar a -> IO () -> IO (Weak (TVar a)) mkWeakTVar t@(TVar t#) f = IO $ \s -> case mkWeak# t# t f s of (# s1, w #) -> (# s1, Weak w #) diff --git a/Control/Monad/STM.hs b/Control/Monad/STM.hs --- a/Control/Monad/STM.hs +++ b/Control/Monad/STM.hs @@ -10,7 +10,7 @@ -- Module : Control.Monad.STM -- 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) @@ -23,19 +23,19 @@ -- and Practice of Parallel Programming/ 2005. -- -- --- This module only defines the 'STM' monad; you probably want to +-- This module only defines the 'STM' monad; you probably want to -- import "Control.Concurrent.STM" (which exports "Control.Monad.STM"). ----------------------------------------------------------------------------- module Control.Monad.STM ( - STM, - atomically, + STM, + atomically, #ifdef __GLASGOW_HASKELL__ always, alwaysSucceeds, - retry, - orElse, - check, + retry, + orElse, + check, #endif throwSTM, catchSTM diff --git a/Control/Sequential/STM.hs b/Control/Sequential/STM.hs --- a/Control/Sequential/STM.hs +++ b/Control/Sequential/STM.hs @@ -4,20 +4,24 @@ {-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 701 +#if __GLASGOW_HASKELL__ >= 709 +{-# LANGUAGE Safe #-} +#elif __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE Trustworthy #-} #endif -- #hide module Control.Sequential.STM ( - STM, atomically, throwSTM, catchSTM, - TVar, newTVar, newTVarIO, readTVar, readTVarIO, writeTVar + STM, atomically, throwSTM, catchSTM, + TVar, newTVar, newTVarIO, readTVar, readTVarIO, writeTVar ) where #if __GLASGOW_HASKELL__ < 705 import Prelude hiding (catch) #endif +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(pure, (<*>))) +#endif import Control.Exception import Data.IORef @@ -37,15 +41,15 @@ instance Monad STM where return = pure STM m >>= k = STM $ \ r -> do - x <- m r - unSTM (k x) r + x <- m r + unSTM (k x) r atomically :: STM a -> IO a atomically (STM m) = do r <- newIORef (return ()) m r `onException` do - rollback <- readIORef r - rollback + rollback <- readIORef r + rollback throwSTM :: Exception e => e -> STM a throwSTM = STM . const . throwIO @@ -57,13 +61,13 @@ res <- try (m r) rollback_m <- readIORef r case res of - Left ex -> do - rollback_m - writeIORef r old_rollback - unSTM (h ex) r - Right a -> do - writeIORef r (rollback_m >> old_rollback) - return a + Left ex -> do + rollback_m + writeIORef r old_rollback + unSTM (h ex) r + Right a -> do + writeIORef r (rollback_m >> old_rollback) + return a newtype TVar a = TVar (IORef a) deriving (Eq) diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,15 @@ # Changelog for [`stm` package](http://hackage.haskell.org/package/stm) +## 2.4.4 *Dec 2014* + + * Add support for `base-4.8.0.0` + + * Tighten Safe Haskell bounds + + * Add `mkWeakTMVar` to `Control.Concurrent.STM.TMVar` + + * Add `@since`-annotations + ## 2.4.3 *Mar 2014* * Update behaviour of `newBroadcastTChanIO` to match diff --git a/stm.cabal b/stm.cabal --- a/stm.cabal +++ b/stm.cabal @@ -1,5 +1,6 @@ name: stm -version: 2.4.3 +version: 2.4.4 +-- don't forget to update changelog.md file! license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org @@ -18,11 +19,6 @@ type: git location: http://git.haskell.org/packages/stm.git -source-repository this - type: git - location: http://git.haskell.org/packages/stm.git - tag: stm-2.4.3-release - library default-language: Haskell98 other-extensions: @@ -34,9 +30,11 @@ UnboxedTuples if impl(ghc >= 7.2) other-extensions: Trustworthy + if impl(ghc >= 7.9) + other-extensions: Safe build-depends: - base >= 4.2 && < 4.8, + base >= 4.2 && < 4.9, array >= 0.3 && < 0.6 exposed-modules: