module Z.Data.Array
(
Arr, MArr
, A.emptyArr, A.singletonArr, A.doubletonArr
, modifyIndexArr, insertIndexArr, deleteIndexArr
, RealWorld
, A.Array(..)
, A.MutableArray(..)
, A.SmallArray(..)
, A.SmallMutableArray(..)
, A.uninitialized
, A.PrimArray(..)
, A.MutablePrimArray(..)
, Prim(..)
, newArr
, newArrWith
, readArr
, writeArr
, setArr
, indexArr
, indexArr'
, indexArrM
, freezeArr
, thawArr
, copyArr
, copyMutableArr
, moveArr
, cloneArr
, cloneMutableArr
, resizeMutableArr
, shrinkMutableArr
, A.unsafeFreezeArr
, A.unsafeThawArr
, A.sameMutableArr
, A.sizeofArr
, A.sizeofMutableArr
, A.sameArr
, newPinnedPrimArray, newAlignedPinnedPrimArray
, copyPrimArrayToPtr, copyMutablePrimArrayToPtr, copyPtrToMutablePrimArray
, A.primArrayContents, A.mutablePrimArrayContents, A.withPrimArrayContents, A.withMutablePrimArrayContents
, A.isPrimArrayPinned, A.isMutablePrimArrayPinned
, A.UnliftedArray(..)
, A.MutableUnliftedArray(..)
, A.PrimUnlifted(..)
, ArrayException(..)
, A.Cast
, A.castArray
, A.castMutableArray
, sizeOf
) where
import Control.Exception (ArrayException (..), throw)
import Control.Monad.Primitive
import Data.Primitive.Types
import GHC.Stack
import Z.Data.Array.Base (Arr, MArr)
import qualified Z.Data.Array.Base as A
#ifdef CHECK_ARRAY_BOUND
import Control.Monad
import Control.Monad.ST
#endif
#ifdef CHECK_ARRAY_BOUND
check :: HasCallStack => Bool -> a -> a
{-# INLINE check #-}
check True x = x
check False _ = throw (IndexOutOfBounds $ show callStack)
#endif
newArr :: (Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack)
=> Int -> m (MArr arr s a)
newArr :: Int -> m (MArr arr s a)
newArr Int
n =
#ifdef CHECK_ARRAY_BOUND
check (n>=0) (A.newArr n)
#else
Int -> m (MArr arr s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
A.newArr Int
n
#endif
{-# INLINE newArr #-}
newArrWith :: (Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack)
=> Int -> a -> m (MArr arr s a)
newArrWith :: Int -> a -> m (MArr arr s a)
newArrWith Int
n a
x =
#ifdef CHECK_ARRAY_BOUND
check (n>=0) (A.newArrWith n x)
#else
(Int -> a -> m (MArr arr s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> a -> m (MArr arr s a)
A.newArrWith Int
n a
x)
#endif
{-# INLINE newArrWith #-}
readArr :: (Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack)
=> MArr arr s a -> Int -> m a
readArr :: MArr arr s a -> Int -> m a
readArr MArr arr s a
marr Int
i = do
#ifdef CHECK_ARRAY_BOUND
siz <- A.sizeofMutableArr marr
check
(i>=0 && i<siz)
(A.readArr marr i)
#else
(MArr arr s a -> Int -> m a
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m a
A.readArr MArr arr s a
marr Int
i)
#endif
{-# INLINE readArr #-}
writeArr :: (Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack)
=> MArr arr s a -> Int -> a -> m ()
writeArr :: MArr arr s a -> Int -> a -> m ()
writeArr MArr arr s a
marr Int
i a
x = do
#ifdef CHECK_ARRAY_BOUND
siz <- A.sizeofMutableArr marr
check
(i>=0 && i<siz)
(A.writeArr marr i x)
#else
(MArr arr s a -> Int -> a -> m ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
A.writeArr MArr arr s a
marr Int
i a
x)
#endif
{-# INLINE writeArr #-}
setArr :: (Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack)
=> MArr arr s a -> Int -> Int -> a -> m ()
setArr :: MArr arr s a -> Int -> Int -> a -> m ()
setArr MArr arr s a
marr Int
s Int
l a
x = do
#ifdef CHECK_ARRAY_BOUND
siz <- A.sizeofMutableArr marr
check
(s>=0 && l>=0 && (s+l)<=siz)
(A.setArr marr s l x)
#else
(MArr arr s a -> Int -> Int -> a -> m ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> Int -> a -> m ()
A.setArr MArr arr s a
marr Int
s Int
l a
x)
#endif
{-# INLINE setArr #-}
indexArr :: (Arr arr a, HasCallStack)
=> arr a -> Int -> a
indexArr :: arr a -> Int -> a
indexArr arr a
arr Int
i =
#ifdef CHECK_ARRAY_BOUND
check (i>=0 && i<A.sizeofArr arr) (A.indexArr arr i)
#else
(arr a -> Int -> a
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> a
A.indexArr arr a
arr Int
i)
#endif
{-# INLINE indexArr #-}
indexArr' :: (Arr arr a, HasCallStack)
=> arr a -> Int -> (# a #)
indexArr' :: arr a -> Int -> (# a #)
indexArr' arr a
arr Int
i =
#ifdef CHECK_ARRAY_BOUND
if (i>=0 && i<A.sizeofArr arr)
then A.indexArr' arr i
else throw (IndexOutOfBounds $ show callStack)
#else
(arr a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
A.indexArr' arr a
arr Int
i)
#endif
{-# INLINE indexArr' #-}
indexArrM :: (Arr arr a, Monad m, HasCallStack)
=> arr a -> Int -> m a
indexArrM :: arr a -> Int -> m a
indexArrM arr a
arr Int
i =
#ifdef CHECK_ARRAY_BOUND
check
(i>=0 && i<A.sizeofArr arr)
(A.indexArrM arr i)
#else
(arr a -> Int -> m a
forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m) =>
arr a -> Int -> m a
A.indexArrM arr a
arr Int
i)
#endif
{-# INLINE indexArrM #-}
freezeArr :: (Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack)
=> MArr arr s a -> Int -> Int -> m (arr a)
freezeArr :: MArr arr s a -> Int -> Int -> m (arr a)
freezeArr MArr arr s a
marr Int
s Int
l = do
#ifdef CHECK_ARRAY_BOUND
siz <- A.sizeofMutableArr marr
check
(s>=0 && l>=0 && (s+l)<=siz)
(A.freezeArr marr s l)
#else
(MArr arr s a -> Int -> Int -> m (arr a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> Int -> m (arr a)
A.freezeArr MArr arr s a
marr Int
s Int
l)
#endif
{-# INLINE freezeArr #-}
thawArr :: (Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack)
=> arr a -> Int -> Int -> m (MArr arr s a)
thawArr :: arr a -> Int -> Int -> m (MArr arr s a)
thawArr arr a
arr Int
s Int
l =
#ifdef CHECK_ARRAY_BOUND
check
(s>=0 && l>=0 && (s+l)<=A.sizeofArr arr)
(A.thawArr arr s l)
#else
(arr a -> Int -> Int -> m (MArr arr s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
arr a -> Int -> Int -> m (MArr arr s a)
A.thawArr arr a
arr Int
s Int
l)
#endif
{-# INLINE thawArr #-}
copyArr :: (Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack)
=> MArr arr s a -> Int -> arr a -> Int -> Int -> m ()
copyArr :: MArr arr s a -> Int -> arr a -> Int -> Int -> m ()
copyArr MArr arr s a
marr Int
s1 arr a
arr Int
s2 Int
l = do
#ifdef CHECK_ARRAY_BOUND
siz <- A.sizeofMutableArr marr
check
(s1>=0 && s2>=0 && l>=0 && (s2+l)<=A.sizeofArr arr && (s1+l)<=siz)
(A.copyArr marr s1 arr s2 l)
#else
(MArr arr s a -> Int -> arr a -> Int -> Int -> m ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> arr a -> Int -> Int -> m ()
A.copyArr MArr arr s a
marr Int
s1 arr a
arr Int
s2 Int
l)
#endif
{-# INLINE copyArr #-}
copyMutableArr :: (Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack)
=> MArr arr s a -> Int -> MArr arr s a -> Int -> Int -> m ()
copyMutableArr :: MArr arr s a -> Int -> MArr arr s a -> Int -> Int -> m ()
copyMutableArr MArr arr s a
marr1 Int
s1 MArr arr s a
marr2 Int
s2 Int
l = do
#ifdef CHECK_ARRAY_BOUND
siz1 <- A.sizeofMutableArr marr1
siz2 <- A.sizeofMutableArr marr2
check
(s1>=0 && s2>=0 && l>=0 && (s2+l)<=siz2 && (s1+l)<=siz1)
(A.copyMutableArr marr1 s1 marr2 s2 l)
#else
(MArr arr s a -> Int -> MArr arr s a -> Int -> Int -> m ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> MArr arr s a -> Int -> Int -> m ()
A.copyMutableArr MArr arr s a
marr1 Int
s1 MArr arr s a
marr2 Int
s2 Int
l)
#endif
{-# INLINE copyMutableArr #-}
moveArr :: (Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack)
=> MArr arr s a -> Int -> MArr arr s a -> Int -> Int -> m ()
moveArr :: MArr arr s a -> Int -> MArr arr s a -> Int -> Int -> m ()
moveArr MArr arr s a
marr1 Int
s1 MArr arr s a
marr2 Int
s2 Int
l = do
#ifdef CHECK_ARRAY_BOUND
siz1 <- A.sizeofMutableArr marr1
siz2 <- A.sizeofMutableArr marr2
check
(s1>=0 && s2>=0 && l>=0 && (s2+l)<=siz2 && (s1+l)<=siz1)
(A.moveArr marr1 s1 marr2 s2 l)
#else
(MArr arr s a -> Int -> MArr arr s a -> Int -> Int -> m ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> MArr arr s a -> Int -> Int -> m ()
A.moveArr MArr arr s a
marr1 Int
s1 MArr arr s a
marr2 Int
s2 Int
l)
#endif
{-# INLINE moveArr #-}
cloneArr :: (Arr arr a, HasCallStack)
=> arr a -> Int -> Int -> arr a
cloneArr :: arr a -> Int -> Int -> arr a
cloneArr arr a
arr Int
s Int
l =
#ifdef CHECK_ARRAY_BOUND
check
(s>=0 && l>=0 && (s+l)<=A.sizeofArr arr)
(A.cloneArr arr s l)
#else
(arr a -> Int -> Int -> arr a
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> Int -> arr a
A.cloneArr arr a
arr Int
s Int
l)
#endif
{-# INLINE cloneArr #-}
cloneMutableArr :: (Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack)
=> MArr arr s a -> Int -> Int -> m (MArr arr s a)
cloneMutableArr :: MArr arr s a -> Int -> Int -> m (MArr arr s a)
cloneMutableArr MArr arr s a
marr Int
s Int
l = do
#ifdef CHECK_ARRAY_BOUND
siz <- A.sizeofMutableArr marr
check
(s>=0 && l>=0 && (s+l)<=siz)
(A.cloneMutableArr marr s l)
#else
(MArr arr s a -> Int -> Int -> m (MArr arr s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> Int -> m (MArr arr s a)
A.cloneMutableArr MArr arr s a
marr Int
s Int
l)
#endif
{-# INLINE cloneMutableArr #-}
resizeMutableArr :: (Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack)
=> MArr arr s a -> Int -> m (MArr arr s a)
resizeMutableArr :: MArr arr s a -> Int -> m (MArr arr s a)
resizeMutableArr MArr arr s a
marr Int
n =
#ifdef CHECK_ARRAY_BOUND
check (n>=0) (A.resizeMutableArr marr n)
#else
(MArr arr s a -> Int -> m (MArr arr s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m (MArr arr s a)
A.resizeMutableArr MArr arr s a
marr Int
n)
#endif
{-# INLINE resizeMutableArr #-}
shrinkMutableArr :: (Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack)
=> MArr arr s a -> Int -> m ()
shrinkMutableArr :: MArr arr s a -> Int -> m ()
shrinkMutableArr MArr arr s a
marr Int
n = do
#ifdef CHECK_ARRAY_BOUND
siz <- A.sizeofMutableArr marr
check
(n>=0 && n<=siz)
(A.shrinkMutableArr marr n)
#else
(MArr arr s a -> Int -> m ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m ()
A.shrinkMutableArr MArr arr s a
marr Int
n)
#endif
{-# INLINE shrinkMutableArr #-}
newPinnedPrimArray :: (PrimMonad m, Prim a, HasCallStack)
=> Int -> m (A.MutablePrimArray (PrimState m) a)
{-# INLINE newPinnedPrimArray #-}
newPinnedPrimArray :: Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
n =
#ifdef CHECK_ARRAY_BOUND
check (n>=0) (A.newPinnedPrimArray n)
#else
(Int -> m (MutablePrimArray (PrimState m) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
A.newPinnedPrimArray Int
n)
#endif
newAlignedPinnedPrimArray :: (PrimMonad m, Prim a, HasCallStack)
=> Int -> m (A.MutablePrimArray (PrimState m) a)
{-# INLINE newAlignedPinnedPrimArray #-}
newAlignedPinnedPrimArray :: Int -> m (MutablePrimArray (PrimState m) a)
newAlignedPinnedPrimArray Int
n =
#ifdef CHECK_ARRAY_BOUND
check (n>=0) (A.newAlignedPinnedPrimArray n)
#else
(Int -> m (MutablePrimArray (PrimState m) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
A.newAlignedPinnedPrimArray Int
n)
#endif
copyPrimArrayToPtr :: (PrimMonad m, Prim a, HasCallStack)
=> Ptr a
-> A.PrimArray a
-> Int
-> Int
-> m ()
{-# INLINE copyPrimArrayToPtr #-}
copyPrimArrayToPtr :: Ptr a -> PrimArray a -> Int -> Int -> m ()
copyPrimArrayToPtr Ptr a
ptr PrimArray a
arr Int
s Int
l =
#ifdef CHECK_ARRAY_BOUND
check
(s>=0 && l>=0 && (s+l)<=A.sizeofArr arr)
(A.copyPrimArrayToPtr ptr arr s l)
#else
(Ptr a -> PrimArray a -> Int -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> PrimArray a -> Int -> Int -> m ()
A.copyPrimArrayToPtr Ptr a
ptr PrimArray a
arr Int
s Int
l)
#endif
copyMutablePrimArrayToPtr :: (PrimMonad m, Prim a, HasCallStack)
=> Ptr a
-> A.MutablePrimArray (PrimState m) a
-> Int
-> Int
-> m ()
{-# INLINE copyMutablePrimArrayToPtr #-}
copyMutablePrimArrayToPtr :: Ptr a -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArrayToPtr Ptr a
ptr MutablePrimArray (PrimState m) a
marr Int
s Int
l = do
#ifdef CHECK_ARRAY_BOUND
siz <- A.sizeofMutableArr marr
check
(s>=0 && l>=0 && (s+l)<=siz)
(A.copyMutablePrimArrayToPtr ptr marr s l)
#else
(Ptr a -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
A.copyMutablePrimArrayToPtr Ptr a
ptr MutablePrimArray (PrimState m) a
marr Int
s Int
l)
#endif
copyPtrToMutablePrimArray :: (PrimMonad m, Prim a, HasCallStack)
=> A.MutablePrimArray (PrimState m) a
-> Int
-> Ptr a
-> Int
-> m ()
{-# INLINE copyPtrToMutablePrimArray #-}
copyPtrToMutablePrimArray :: MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray (PrimState m) a
marr Int
s Ptr a
ptr Int
l = do
#ifdef CHECK_ARRAY_BOUND
siz <- A.sizeofMutableArr marr
check
(s>=0 && l>=0 && (s+l)<=siz)
(A.copyPtrToMutablePrimArray marr s ptr l)
#else
(MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
A.copyPtrToMutablePrimArray MutablePrimArray (PrimState m) a
marr Int
s Ptr a
ptr Int
l)
#endif
modifyIndexArr :: (Arr arr a, HasCallStack) => arr a
-> Int
-> Int
-> Int
-> (a -> a)
-> arr a
{-# INLINE modifyIndexArr #-}
modifyIndexArr :: arr a -> Int -> Int -> Int -> (a -> a) -> arr a
modifyIndexArr arr a
arr Int
off Int
len Int
ix a -> a
f =
#ifdef CHECK_ARRAY_BOUND
runST $ do
marr <- A.unsafeThawArr (cloneArr arr off len)
!v <- f <$> readArr marr ix
writeArr marr ix v
A.unsafeFreezeArr marr
#else
arr a -> Int -> Int -> Int -> (a -> a) -> arr a
forall (arr :: * -> *) a.
Arr arr a =>
arr a -> Int -> Int -> Int -> (a -> a) -> arr a
A.modifyIndexArr arr a
arr Int
off Int
len Int
ix a -> a
f
#endif
insertIndexArr :: Arr arr a
=> arr a
-> Int
-> Int
-> Int
-> a
-> arr a
{-# INLINE insertIndexArr #-}
insertIndexArr :: arr a -> Int -> Int -> Int -> a -> arr a
insertIndexArr arr a
arr Int
s Int
l Int
i a
x =
#ifdef CHECK_ARRAY_BOUND
runST $ do
marr <- newArrWith (l+1) x
when (i>0) $ copyArr marr 0 arr s i
when (i<l) $ copyArr marr (i+1) arr (i+s) (l-i)
A.unsafeFreezeArr marr
#else
arr a -> Int -> Int -> Int -> a -> arr a
forall (arr :: * -> *) a.
Arr arr a =>
arr a -> Int -> Int -> Int -> a -> arr a
A.insertIndexArr arr a
arr Int
s Int
l Int
i a
x
#endif
deleteIndexArr :: Arr arr a
=> arr a
-> Int
-> Int
-> Int
-> arr a
{-# INLINE deleteIndexArr #-}
deleteIndexArr :: arr a -> Int -> Int -> Int -> arr a
deleteIndexArr arr a
arr Int
s Int
l Int
i =
#ifdef CHECK_ARRAY_BOUND
runST $ do
marr <- newArr (l-1)
when (i>0) $ copyArr marr 0 arr s i
let i' = i+1
when (i'<l) $ copyArr marr i arr (i'+s) (l-i')
A.unsafeFreezeArr marr
#else
arr a -> Int -> Int -> Int -> arr a
forall (arr :: * -> *) a.
Arr arr a =>
arr a -> Int -> Int -> Int -> arr a
A.deleteIndexArr arr a
arr Int
s Int
l Int
i
#endif