stm 2.1 → 2.1.1.0
raw patch · 6 files changed
+75/−6 lines, 6 filesdep +arraydep ~basesetup-changed
Dependencies added: array
Dependency ranges changed: base
Files
- Control/Concurrent/STM/TArray.hs +3/−2
- Control/Concurrent/STM/TChan.hs +17/−0
- Control/Concurrent/STM/TMVar.hs +43/−0
- Control/Monad/STM.hs +4/−0
- Setup.hs +5/−1
- stm.cabal +3/−3
Control/Concurrent/STM/TArray.hs view
@@ -19,7 +19,8 @@ import Control.Monad (replicateM) import Data.Array (Array, bounds)-import Data.Array.Base (listArray, arrEleBottom, unsafeAt, MArray(..))+import Data.Array.Base (listArray, arrEleBottom, unsafeAt, MArray(..),+ IArray(numElements)) import Data.Ix (rangeSize) import Control.Concurrent.STM.TVar (TVar, newTVar, readTVar, writeTVar) #ifdef __GLASGOW_HASKELL__@@ -47,4 +48,4 @@ return $ TArray (listArray b a) unsafeRead (TArray a) i = readTVar $ unsafeAt a i unsafeWrite (TArray a) i e = writeTVar (unsafeAt a i) e-+ getNumElements (TArray a) = return (numElements a)
Control/Concurrent/STM/TChan.hs view
@@ -9,10 +9,12 @@ -- Portability : non-portable (requires STM) -- -- TChan: Transactional channels+-- (GHC only) -- ----------------------------------------------------------------------------- module Control.Concurrent.STM.TChan (+#ifdef __GLASGOW_HASKELL__ -- * TChans TChan, newTChan,@@ -22,8 +24,10 @@ dupTChan, unGetTChan, isEmptyTChan+#endif ) where +#ifdef __GLASGOW_HASKELL__ import GHC.Conc -- | 'TChan' is an abstract type representing an unbounded FIFO channel.@@ -32,6 +36,7 @@ type TVarList a = TVar (TList a) data TList a = TNil | TCons a (TVarList a) +-- |Build and returns a new instance of 'TChan' newTChan :: STM (TChan a) newTChan = do hole <- newTVar TNil@@ -39,6 +44,10 @@ write <- newTVar hole return (TChan read write) +-- |@IO@ version of 'newTChan'. This is useful for creating top-level+-- 'TChan's using 'System.IO.Unsafe.unsafePerformIO', because using+-- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't+-- possible. newTChanIO :: IO (TChan a) newTChanIO = do hole <- newTVarIO TNil@@ -46,6 +55,7 @@ write <- newTVarIO hole return (TChan read write) +-- |Write a value to a 'TChan'. writeTChan :: TChan a -> a -> STM () writeTChan (TChan _read write) a = do listend <- readTVar write -- listend == TVar pointing to TNil@@ -53,6 +63,7 @@ writeTVar listend (TCons a new_listend) writeTVar write new_listend +-- |Read the next value from the 'TChan'. readTChan :: TChan a -> STM a readTChan (TChan read _write) = do listhead <- readTVar read@@ -63,12 +74,17 @@ writeTVar read tail return a +-- |Duplicate a 'TChan': the duplicate channel begins empty, but data written to+-- either channel from then on will be available from both. Hence this creates+-- a kind of broadcast channel, where data written by anyone is seen by+-- everyone else. dupTChan :: TChan a -> STM (TChan a) dupTChan (TChan read write) = do hole <- readTVar write new_read <- newTVar hole return (TChan new_read write) +-- |Put a data item back onto a channel, where it will be the next item read. unGetTChan :: TChan a -> a -> STM () unGetTChan (TChan read _write) a = do listhead <- readTVar read@@ -83,3 +99,4 @@ case head of TNil -> return True TCons _ _ -> return False+#endif
Control/Concurrent/STM/TMVar.hs view
@@ -9,10 +9,12 @@ -- Portability : non-portable (requires STM) -- -- TMVar: Transactional MVars, for use in the STM monad+-- (GHC only) -- ----------------------------------------------------------------------------- module Control.Concurrent.STM.TMVar (+#ifdef __GLASGOW_HASKELL__ -- * TVars TMVar, newTMVar,@@ -26,32 +28,52 @@ tryTakeTMVar, tryPutTMVar, isEmptyTMVar+#endif ) where +#ifdef __GLASGOW_HASKELL__ import GHC.Conc newtype TMVar a = TMVar (TVar (Maybe a))+{- ^+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@@ -59,6 +81,10 @@ 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@@ -66,6 +92,8 @@ 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@@ -73,6 +101,9 @@ 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@@ -80,6 +111,10 @@ 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@@ -87,6 +122,7 @@ Nothing -> retry Just a -> return a +-- |Swap the contents of a 'TMVar' for a new value. swapTMVar :: TMVar a -> a -> STM a swapTMVar (TMVar t) new = do m <- readTVar t@@ -94,9 +130,16 @@ Nothing -> retry Just old -> do writeTVar t (Just new); return old +-- |Check whether a given 'TMVar' is empty.+--+-- Notice that the boolean value returned is just a snapshot of+-- the state of the 'TMVar'. By the time you get to react on its result,+-- the 'TMVar' may have been filled (or emptied) - so be extremely+-- careful when using this operation. Use 'tryTakeTMVar' instead if possible. isEmptyTMVar :: TMVar a -> STM Bool isEmptyTMVar (TMVar t) = do m <- readTVar t case m of Nothing -> return True Just _ -> return False+#endif
Control/Monad/STM.hs view
@@ -16,12 +16,16 @@ -- and Practice of Parallel Programming/ 2005. -- <http://research.microsoft.com/Users/simonpj/papers/stm/index.htm> --+-- 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, #ifdef __GLASGOW_HASKELL__+ always,+ alwaysSucceeds, retry, orElse, check,
Setup.hs view
@@ -1,2 +1,6 @@+module Main (main) where+ import Distribution.Simple-main = defaultMainWithHooks defaultUserHooks++main :: IO ()+main = defaultMain
stm.cabal view
@@ -1,5 +1,5 @@ name: stm-version: 2.1+version: 2.1.1.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org@@ -9,11 +9,11 @@ exposed-modules: Control.Concurrent.STM Control.Concurrent.STM.TArray+ Control.Concurrent.STM.TVar Control.Concurrent.STM.TChan Control.Concurrent.STM.TMVar- Control.Concurrent.STM.TVar Control.Monad.STM other-modules: Control.Sequential.STM-build-depends: base+build-depends: base, array extensions: CPP