{-# 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
(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)
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)