{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}

#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif

-----------------------------------------------------------------------------
-- |
-- 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 Data.Array (Array, bounds)
import Data.Array.Base (listArray, arrEleBottom, unsafeAt, MArray(..),
                        IArray(numElements))
import Data.Ix (rangeSize)
import Data.Typeable (Typeable)
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)) deriving (TArray i e -> TArray i e -> Bool
(TArray i e -> TArray i e -> Bool)
-> (TArray i e -> TArray i e -> Bool) -> Eq (TArray i e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall i e. Ix i => TArray i e -> TArray i e -> Bool
/= :: TArray i e -> TArray i e -> Bool
$c/= :: forall i e. Ix i => TArray i e -> TArray i e -> Bool
== :: TArray i e -> TArray i e -> Bool
$c== :: forall i e. Ix i => TArray i e -> TArray i e -> Bool
Eq, Typeable)

instance MArray TArray e STM where
    getBounds :: forall i. Ix i => TArray i e -> STM (i, i)
getBounds (TArray Array i (TVar e)
a) = (i, i) -> STM (i, i)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array i (TVar e) -> (i, i)
forall i e. Array i e -> (i, i)
bounds Array i (TVar e)
a)
    newArray :: forall i. Ix i => (i, i) -> e -> STM (TArray i e)
newArray (i, i)
b e
e = do
        [TVar e]
a <- Int -> STM (TVar e) -> STM [TVar e]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
rep ((i, i) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize (i, i)
b) (e -> STM (TVar e)
forall a. a -> STM (TVar a)
newTVar e
e)
        TArray i e -> STM (TArray i e)
forall (m :: * -> *) a. Monad m => a -> m a
return (TArray i e -> STM (TArray i e)) -> TArray i e -> STM (TArray i e)
forall a b. (a -> b) -> a -> b
$ Array i (TVar e) -> TArray i e
forall i e. Array i (TVar e) -> TArray i e
TArray ((i, i) -> [TVar e] -> Array i (TVar e)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (i, i)
b [TVar e]
a)
    newArray_ :: forall i. Ix i => (i, i) -> STM (TArray i e)
newArray_ (i, i)
b = do
        [TVar e]
a <- Int -> STM (TVar e) -> STM [TVar e]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
rep ((i, i) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize (i, i)
b) (e -> STM (TVar e)
forall a. a -> STM (TVar a)
newTVar e
forall a. a
arrEleBottom)
        TArray i e -> STM (TArray i e)
forall (m :: * -> *) a. Monad m => a -> m a
return (TArray i e -> STM (TArray i e)) -> TArray i e -> STM (TArray i e)
forall a b. (a -> b) -> a -> b
$ Array i (TVar e) -> TArray i e
forall i e. Array i (TVar e) -> TArray i e
TArray ((i, i) -> [TVar e] -> Array i (TVar e)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (i, i)
b [TVar e]
a)
    unsafeRead :: forall i. Ix i => TArray i e -> Int -> STM e
unsafeRead (TArray Array i (TVar e)
a) Int
i = TVar e -> STM e
forall a. TVar a -> STM a
readTVar (TVar e -> STM e) -> TVar e -> STM e
forall a b. (a -> b) -> a -> b
$ Array i (TVar e) -> Int -> TVar e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt Array i (TVar e)
a Int
i
    unsafeWrite :: forall i. Ix i => TArray i e -> Int -> e -> STM ()
unsafeWrite (TArray Array i (TVar e)
a) Int
i e
e = TVar e -> e -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (Array i (TVar e) -> Int -> TVar e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt Array i (TVar e)
a Int
i) e
e
    getNumElements :: forall i. Ix i => TArray i e -> STM Int
getNumElements (TArray Array i (TVar e)
a) = Int -> STM Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Array i (TVar e) -> Int
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> Int
numElements Array i (TVar e)
a)

-- | Like 'replicateM' but uses an accumulator to prevent stack overflows.
-- Unlike 'replicateM' the returned list is in reversed order.
-- This doesn't matter though since this function is only used to create
-- arrays with identical elements.
rep :: Monad m => Int -> m a -> m [a]
rep :: forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
rep Int
n m a
m = Int -> [a] -> m [a]
forall {t}. (Eq t, Num t) => t -> [a] -> m [a]
go Int
n []
    where
      go :: t -> [a] -> m [a]
go t
0 [a]
xs = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs
      go t
i [a]
xs = do
          a
x <- m a
m
          t -> [a] -> m [a]
go (t
it -> t -> t
forall a. Num a => a -> a -> a
-t
1) (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)