    {-# 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
    $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
    /= :: 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 a. a -> STM a
    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 a. a -> STM a
    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 a. a -> STM a
    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 i. Ix i => 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 i. Ix i => 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 a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Array i (TVar e) -> Int
    forall i. Ix i => 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 a. 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)