[project @ 2005-12-15 09:38:13 by simonmar]

Add TArray, a simple transactional array based on immutable arrays of
TVars, with the usual MArray interface.

Code from Taral <taralx@gmail.com>

Control/Concurrent/STM.hs

@@ -30,7 +30,10 @@ module Control.Concurrent.STM (
 	module Control.Concurrent.STM.TMVar,
 
 	-- * TChan
-	module Control.Concurrent.STM.TChan
+	module Control.Concurrent.STM.TChan,
+
+	-- * TArray
+	module Control.Concurrent.STM.TArray
   ) where
 
 import GHC.Conc
@@ -38,6 +41,7 @@ import Control.Monad	( MonadPlus(..) )
 import Control.Concurrent.STM.TVar
 import Control.Concurrent.STM.TMVar
 import Control.Concurrent.STM.TChan
+import Control.Concurrent.STM.TArray
 
 instance MonadPlus STM where
   mzero = retry

Control/Concurrent/STM/TArray.hs

+{-# 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)
+import Data.Array.Base (listArray, arrEleBottom, unsafeAt, MArray(..), HasBounds(..))
+import Data.Ix (rangeSize)
+import Control.Concurrent.STM.TVar (TVar, newTVar, readTVar, writeTVar)
+import GHC.Conc (STM)
+
+-- |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
+    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
+
+instance HasBounds TArray where
+    bounds (TArray a) = bounds a
+