packages feed

stm (empty) → 2.1

raw patch · 10 files changed

+474/−0 lines, 10 filesdep +basebuild-type:Customsetup-changed

Dependencies added: base

Files

+ Control/Concurrent/STM.hs view
@@ -0,0 +1,37 @@+-----------------------------------------------------------------------------+-- |+-- 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)+--+-- Software Transactional Memory: a modular composable concurrency+-- 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>+--+-----------------------------------------------------------------------------++module Control.Concurrent.STM (+	module Control.Monad.STM,+	module Control.Concurrent.STM.TVar,+#ifdef __GLASGOW_HASKELL__+	module Control.Concurrent.STM.TMVar,+	module Control.Concurrent.STM.TChan,+#endif+	module Control.Concurrent.STM.TArray+  ) where++import Control.Monad.STM+import Control.Concurrent.STM.TVar+#ifdef __GLASGOW_HASKELL__+import Control.Concurrent.STM.TMVar+import Control.Concurrent.STM.TChan+#endif+import Control.Concurrent.STM.TArray
+ Control/Concurrent/STM/TArray.hs view
@@ -0,0 +1,50 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Concurrent.STM.TArray+-- Copyright   :  (c) The University of Glasgow 2005+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (requires STM)+--+-- TArrays: transactional arrays, for use in the STM monad+--+-----------------------------------------------------------------------------++module Control.Concurrent.STM.TArray (+    TArray+) where++import Control.Monad (replicateM)+import Data.Array (Array, bounds)+import Data.Array.Base (listArray, arrEleBottom, unsafeAt, MArray(..))+import Data.Ix (rangeSize)+import Control.Concurrent.STM.TVar (TVar, newTVar, readTVar, writeTVar)+#ifdef __GLASGOW_HASKELL__+import GHC.Conc (STM)+#else+import Control.Sequential.STM (STM)+#endif++-- |TArray is a transactional array, supporting the usual 'MArray'+-- interface for mutable arrays.+--+-- It is currently implemented as @Array ix (TVar e)@,+-- but it may be replaced by a more efficient implementation in the future+-- (the interface will remain the same, however).+--+newtype TArray i e = TArray (Array i (TVar e))++instance MArray TArray e STM where+    getBounds (TArray a) = return (bounds a)+    newArray b e = do+        a <- replicateM (rangeSize b) (newTVar e)+        return $ TArray (listArray b a)+    newArray_ b = do+        a <- replicateM (rangeSize b) (newTVar arrEleBottom)+        return $ TArray (listArray b a)+    unsafeRead (TArray a) i = readTVar $ unsafeAt a i+    unsafeWrite (TArray a) i e = writeTVar (unsafeAt a i) e+
+ Control/Concurrent/STM/TChan.hs view
@@ -0,0 +1,85 @@+-----------------------------------------------------------------------------+-- |+-- 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)+--+-- TChan: Transactional channels+--+-----------------------------------------------------------------------------++module Control.Concurrent.STM.TChan (+	-- * TChans+	TChan,+	newTChan,+	newTChanIO,+	readTChan,+	writeTChan,+	dupTChan,+	unGetTChan,+	isEmptyTChan+  ) where++import GHC.Conc++-- | 'TChan' is an abstract type representing an unbounded FIFO channel.+data TChan a = TChan (TVar (TVarList a)) (TVar (TVarList a))++type TVarList a = TVar (TList a)+data TList a = TNil | TCons a (TVarList a)++newTChan :: STM (TChan a)+newTChan = do+  hole <- newTVar TNil+  read <- newTVar hole+  write <- newTVar hole+  return (TChan read write)++newTChanIO :: IO (TChan a)+newTChanIO = do+  hole <- newTVarIO TNil+  read <- newTVarIO hole+  write <- newTVarIO hole+  return (TChan read write)++writeTChan :: TChan a -> a -> STM ()+writeTChan (TChan _read write) a = do+  listend <- readTVar write -- listend == TVar pointing to TNil+  new_listend <- newTVar TNil+  writeTVar listend (TCons a new_listend)+  writeTVar write new_listend++readTChan :: TChan a -> STM a+readTChan (TChan read _write) = do+  listhead <- readTVar read+  head <- readTVar listhead+  case head of+    TNil -> retry+    TCons a tail -> do+	writeTVar read tail+	return a++dupTChan :: TChan a -> STM (TChan a)+dupTChan (TChan read write) = do+  hole <- readTVar write  +  new_read <- newTVar hole+  return (TChan new_read write)++unGetTChan :: TChan a -> a -> STM ()+unGetTChan (TChan read _write) a = do+   listhead <- readTVar read+   newhead <- newTVar (TCons a listhead)+   writeTVar read newhead++-- |Returns 'True' if the supplied 'TChan' is empty.+isEmptyTChan :: TChan a -> STM Bool+isEmptyTChan (TChan read write) = do+  listhead <- readTVar read+  head <- readTVar listhead+  case head of+    TNil -> return True+    TCons _ _ -> return False
+ Control/Concurrent/STM/TMVar.hs view
@@ -0,0 +1,102 @@+-----------------------------------------------------------------------------+-- |+-- 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+--+-----------------------------------------------------------------------------++module Control.Concurrent.STM.TMVar (+	-- * TVars+	TMVar,+	newTMVar,+	newEmptyTMVar,+	newTMVarIO,+	newEmptyTMVarIO,+	takeTMVar,+	putTMVar,+	readTMVar,	+	swapTMVar,+	tryTakeTMVar,+	tryPutTMVar,+	isEmptyTMVar+  ) where++import GHC.Conc++newtype TMVar a = TMVar (TVar (Maybe a))++newTMVar :: a -> STM (TMVar a)+newTMVar a = do+  t <- newTVar (Just a)+  return (TMVar t)++newTMVarIO :: a -> IO (TMVar a)+newTMVarIO a = do+  t <- newTVarIO (Just a)+  return (TMVar t)++newEmptyTMVar :: STM (TMVar a)+newEmptyTMVar = do+  t <- newTVar Nothing+  return (TMVar t)++newEmptyTMVarIO :: IO (TMVar a)+newEmptyTMVarIO = do+  t <- newTVarIO Nothing+  return (TMVar t)++takeTMVar :: TMVar a -> STM a+takeTMVar (TMVar t) = do+  m <- readTVar t+  case m of+    Nothing -> retry+    Just a  -> do writeTVar t Nothing; return a++tryTakeTMVar :: TMVar a -> STM (Maybe a)+tryTakeTMVar (TMVar t) = do+  m <- readTVar t+  case m of+    Nothing -> return Nothing+    Just a  -> do writeTVar t Nothing; return (Just a)++putTMVar :: TMVar a -> a -> STM ()+putTMVar (TMVar t) a = do+  m <- readTVar t+  case m of+    Nothing -> do writeTVar t (Just a); return ()+    Just _  -> retry++tryPutTMVar :: TMVar a -> a -> STM Bool+tryPutTMVar (TMVar t) a = do+  m <- readTVar t+  case m of+    Nothing -> do writeTVar t (Just a); return True+    Just _  -> return False++readTMVar :: TMVar a -> STM a+readTMVar (TMVar t) = do+  m <- readTVar t+  case m of+    Nothing -> retry+    Just a  -> return a++swapTMVar :: TMVar a -> a -> STM a+swapTMVar (TMVar t) new = do+  m <- readTVar t+  case m of+    Nothing -> retry+    Just old -> do writeTVar t (Just new); return old++isEmptyTMVar :: TMVar a -> STM Bool+isEmptyTMVar (TMVar t) = do+  m <- readTVar t+  case m of+    Nothing -> return True+    Just _  -> return False
+ Control/Concurrent/STM/TVar.hs view
@@ -0,0 +1,31 @@+-----------------------------------------------------------------------------+-- |+-- 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)+--+-- TVar: Transactional variables+--+-----------------------------------------------------------------------------++module Control.Concurrent.STM.TVar (+	-- * TVars+	TVar,+	newTVar,+	readTVar,+	writeTVar,+	newTVarIO,+#ifdef __GLASGOW_HASKELL__+	registerDelay+#endif+  ) where++#ifdef __GLASGOW_HASKELL__+import GHC.Conc+#else+import Control.Sequential.STM+#endif
+ Control/Monad/STM.hs view
@@ -0,0 +1,46 @@+-----------------------------------------------------------------------------+-- |+-- 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)+--+-- Software Transactional Memory: a modular composable concurrency+-- 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>+--+-----------------------------------------------------------------------------++module Control.Monad.STM (+  	STM,+	atomically,+#ifdef __GLASGOW_HASKELL__+	retry,+	orElse,+	check,+#endif+        catchSTM+  ) where++#ifdef __GLASGOW_HASKELL__+import GHC.Conc+import Control.Monad	( MonadPlus(..) )+#else+import Control.Sequential.STM+#endif++#ifdef __GLASGOW_HASKELL__+instance MonadPlus STM where+  mzero = retry+  mplus = orElse++check :: Bool -> STM a+check b = if b then return undefined else retry+#endif
+ Control/Sequential/STM.hs view
@@ -0,0 +1,71 @@+-- Transactional memory for sequential implementations.+-- Transactions do not run concurrently, but are atomic in the face+-- of exceptions.++-- #hide+module Control.Sequential.STM (+	STM, atomically, catchSTM,+	TVar, newTVar, newTVarIO, readTVar, writeTVar+    ) where++import Prelude hiding (catch)+import Control.Exception+import Data.IORef++-- The reference contains a rollback action to be executed on exceptions+newtype STM a = STM (IORef (IO ()) -> IO a)++unSTM :: STM a -> IORef (IO ()) -> IO a+unSTM (STM f) = f++instance Functor STM where+    fmap f (STM m) = STM (fmap f . m)++instance Monad STM where+    return x = STM (const (return x))+    STM m >>= k = STM $ \ r -> do+	x <- m r+	unSTM (k x) r++atomically :: STM a -> IO a+atomically (STM m) = do+    r <- newIORef (return ())+    m r `catch` \ ex -> do+	rollback <- readIORef r+	rollback+	throw ex++catchSTM :: STM a -> (Exception -> STM a) -> STM a+catchSTM (STM m) h = STM $ \ r -> do+    old_rollback <- readIORef r+    writeIORef r (return ())+    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++newtype TVar a = TVar (IORef a)+    deriving (Eq)++newTVar :: a -> STM (TVar a)+newTVar a = STM (const (newTVarIO a))++newTVarIO :: a -> IO (TVar a)+newTVarIO a = do+    ref <- newIORef a+    return (TVar ref)++readTVar :: TVar a -> STM a+readTVar (TVar ref) = STM (const (readIORef ref))++writeTVar :: TVar a -> a -> STM ()+writeTVar (TVar ref) a = STM $ \ r -> do+    oldval <- readIORef ref+    modifyIORef r (writeIORef ref oldval >>)+    writeIORef ref a
+ LICENSE view
@@ -0,0 +1,31 @@+The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow. +All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMainWithHooks defaultUserHooks
+ stm.cabal view
@@ -0,0 +1,19 @@+name:		stm+version:	2.1+license:	BSD3+license-file:	LICENSE+maintainer:	libraries@haskell.org+synopsis:	Software Transactional Memory+description:	A modular composable concurrency abstraction.+-- these are the modules exposed by the cut-down non-GHC interface.+exposed-modules:+		Control.Concurrent.STM+		Control.Concurrent.STM.TArray+		Control.Concurrent.STM.TChan+		Control.Concurrent.STM.TMVar+		Control.Concurrent.STM.TVar+		Control.Monad.STM+other-modules:+		Control.Sequential.STM+build-depends:	base+extensions:	CPP