{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
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
newtype TArray i e = TArray (Array i (TVar e)) deriving (TArray i e -> TArray i e -> Bool
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) = forall (m :: * -> *) a. Monad m => a -> m a
return (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 <- forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
rep (forall a. Ix a => (a, a) -> Int
rangeSize (i, i)
b) (forall a. a -> STM (TVar a)
newTVar e
e)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall i e. Array i (TVar e) -> TArray i e
TArray (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 <- forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
rep (forall a. Ix a => (a, a) -> Int
rangeSize (i, i)
b) (forall a. a -> STM (TVar a)
newTVar forall a. a
arrEleBottom)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall i e. Array i (TVar e) -> TArray i e
TArray (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 = forall a. TVar a -> STM a
readTVar forall a b. (a -> b) -> a -> b
$ 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 = forall a. TVar a -> a -> STM ()
writeTVar (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) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> Int
numElements Array i (TVar e)
a)
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 = forall {t}. (Eq t, Num t) => t -> [a] -> m [a]
go Int
n []
where
go :: t -> [a] -> m [a]
go t
0 [a]
xs = 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
iforall a. Num a => a -> a -> a
-t
1) (a
xforall a. a -> [a] -> [a]
:[a]
xs)