module Data.Primitive.UnliftedArray
( UnliftedArray(..)
, MutableUnliftedArray(..)
, PrimUnlifted(..)
, unsafeNewUnliftedArray
, newUnliftedArray
, setUnliftedArray
, sizeofUnliftedArray
, sizeofMutableUnliftedArray
, readUnliftedArray
, writeUnliftedArray
, indexUnliftedArray
, indexUnliftedArrayM
, unsafeFreezeUnliftedArray
, freezeUnliftedArray
, thawUnliftedArray
, sameMutableUnliftedArray
, copyUnliftedArray
, copyMutableUnliftedArray
, cloneUnliftedArray
, cloneMutableUnliftedArray
) where
import Data.Typeable
import GHC.Prim
import GHC.Base (Int(..))
import Control.Monad.Primitive
import Control.Monad.ST (runST)
import Data.Primitive.Internal.Compat ( isTrue# )
import Data.Primitive.Array (Array)
import qualified Data.Primitive.Array as A
import Data.Primitive.ByteArray (ByteArray)
import qualified Data.Primitive.ByteArray as BA
import qualified Data.Primitive.SmallArray as SA
import qualified Data.Primitive.MutVar as MV
data UnliftedArray e = UnliftedArray ArrayArray#
deriving (Typeable)
data MutableUnliftedArray s e = MutableUnliftedArray (MutableArrayArray# s)
deriving (Typeable)
class PrimUnlifted a where
toArrayArray# :: a -> ArrayArray#
fromArrayArray# :: ArrayArray# -> a
instance PrimUnlifted (UnliftedArray e) where
toArrayArray# (UnliftedArray aa#) = aa#
fromArrayArray# aa# = UnliftedArray aa#
instance PrimUnlifted (MutableUnliftedArray s e) where
toArrayArray# (MutableUnliftedArray maa#) = unsafeCoerce# maa#
fromArrayArray# aa# = MutableUnliftedArray (unsafeCoerce# aa#)
instance PrimUnlifted (Array a) where
toArrayArray# (A.Array a#) = unsafeCoerce# a#
fromArrayArray# aa# = A.Array (unsafeCoerce# aa#)
instance PrimUnlifted (A.MutableArray s a) where
toArrayArray# (A.MutableArray ma#) = unsafeCoerce# ma#
fromArrayArray# aa# = A.MutableArray (unsafeCoerce# aa#)
instance PrimUnlifted ByteArray where
toArrayArray# (BA.ByteArray ba#) = unsafeCoerce# ba#
fromArrayArray# aa# = BA.ByteArray (unsafeCoerce# aa#)
instance PrimUnlifted (BA.MutableByteArray s) where
toArrayArray# (BA.MutableByteArray mba#) = unsafeCoerce# mba#
fromArrayArray# aa# = BA.MutableByteArray (unsafeCoerce# aa#)
instance PrimUnlifted (SA.SmallArray a) where
toArrayArray# (SA.SmallArray sa#) = unsafeCoerce# sa#
fromArrayArray# aa# = SA.SmallArray (unsafeCoerce# aa#)
instance PrimUnlifted (SA.SmallMutableArray s a) where
toArrayArray# (SA.SmallMutableArray sma#) = unsafeCoerce# sma#
fromArrayArray# aa# = SA.SmallMutableArray (unsafeCoerce# aa#)
instance PrimUnlifted (MV.MutVar s a) where
toArrayArray# (MV.MutVar mv#) = unsafeCoerce# mv#
fromArrayArray# aa# = MV.MutVar (unsafeCoerce# aa#)
unsafeNewUnliftedArray
:: (PrimMonad m)
=> Int
-> m (MutableUnliftedArray (PrimState m) a)
unsafeNewUnliftedArray (I# i#) = primitive $ \s -> case newArrayArray# i# s of
(# s', maa# #) -> (# s', MutableUnliftedArray maa# #)
setUnliftedArray
:: (PrimMonad m, PrimUnlifted a)
=> MutableUnliftedArray (PrimState m) a
-> a
-> m ()
setUnliftedArray mua v = loop $ sizeofMutableUnliftedArray mua 1
where
loop i | i < 0 = return ()
| otherwise = writeUnliftedArray mua i v >> loop (i1)
newUnliftedArray
:: (PrimMonad m, PrimUnlifted a)
=> Int
-> a
-> m (MutableUnliftedArray (PrimState m) a)
newUnliftedArray len v =
unsafeNewUnliftedArray len >>= \mua -> setUnliftedArray mua v >> return mua
sizeofUnliftedArray :: UnliftedArray e -> Int
sizeofUnliftedArray (UnliftedArray aa#) = I# (sizeofArrayArray# aa#)
sizeofMutableUnliftedArray :: MutableUnliftedArray s e -> Int
sizeofMutableUnliftedArray (MutableUnliftedArray maa#)
= I# (sizeofMutableArrayArray# maa#)
indexUnliftedArrayU
:: PrimUnlifted a
=> UnliftedArray a
-> Int
-> (# a #)
indexUnliftedArrayU (UnliftedArray src#) (I# i#)
= case indexArrayArrayArray# src# i# of
aa# -> (# fromArrayArray# aa# #)
indexUnliftedArray
:: PrimUnlifted a
=> UnliftedArray a
-> Int
-> a
indexUnliftedArray ua i
= case indexUnliftedArrayU ua i of (# v #) -> v
indexUnliftedArrayM
:: (PrimUnlifted a, Monad m)
=> UnliftedArray a
-> Int
-> m a
indexUnliftedArrayM ua i
= case indexUnliftedArrayU ua i of
(# v #) -> return v
readUnliftedArray
:: (PrimMonad m, PrimUnlifted a)
=> MutableUnliftedArray (PrimState m) a
-> Int
-> m a
readUnliftedArray (MutableUnliftedArray maa#) (I# i#)
= primitive $ \s -> case readArrayArrayArray# maa# i# s of
(# s', aa# #) -> (# s', fromArrayArray# aa# #)
writeUnliftedArray
:: (PrimMonad m, PrimUnlifted a)
=> MutableUnliftedArray (PrimState m) a
-> Int
-> a
-> m ()
writeUnliftedArray (MutableUnliftedArray maa#) (I# i#) a
= primitive_ (writeArrayArrayArray# maa# i# (toArrayArray# a))
unsafeFreezeUnliftedArray
:: (PrimMonad m)
=> MutableUnliftedArray (PrimState m) a
-> m (UnliftedArray a)
unsafeFreezeUnliftedArray (MutableUnliftedArray maa#)
= primitive $ \s -> case unsafeFreezeArrayArray# maa# s of
(# s', aa# #) -> (# s', UnliftedArray aa# #)
sameMutableUnliftedArray
:: MutableUnliftedArray s a
-> MutableUnliftedArray s a
-> Bool
sameMutableUnliftedArray (MutableUnliftedArray maa1#) (MutableUnliftedArray maa2#)
= isTrue# (sameMutableArrayArray# maa1# maa2#)
copyUnliftedArray
:: (PrimMonad m)
=> MutableUnliftedArray (PrimState m) a
-> Int
-> UnliftedArray a
-> Int
-> Int
-> m ()
copyUnliftedArray
(MutableUnliftedArray dst) (I# doff)
(UnliftedArray src) (I# soff) (I# ln) =
primitive_ $ copyArrayArray# src soff dst doff ln
copyMutableUnliftedArray
:: (PrimMonad m)
=> MutableUnliftedArray (PrimState m) a
-> Int
-> MutableUnliftedArray (PrimState m) a
-> Int
-> Int
-> m ()
copyMutableUnliftedArray
(MutableUnliftedArray dst) (I# doff)
(MutableUnliftedArray src) (I# soff) (I# ln) =
primitive_ $ copyMutableArrayArray# src soff dst doff ln
freezeUnliftedArray
:: (PrimMonad m)
=> MutableUnliftedArray (PrimState m) a
-> Int
-> Int
-> m (UnliftedArray a)
freezeUnliftedArray src off len = do
dst <- unsafeNewUnliftedArray len
copyMutableUnliftedArray dst 0 src off len
unsafeFreezeUnliftedArray dst
thawUnliftedArray
:: (PrimMonad m)
=> UnliftedArray a
-> Int
-> Int
-> m (MutableUnliftedArray (PrimState m) a)
thawUnliftedArray src off len = do
dst <- unsafeNewUnliftedArray len
copyUnliftedArray dst 0 src off len
return dst
cloneUnliftedArray
:: UnliftedArray a
-> Int
-> Int
-> UnliftedArray a
cloneUnliftedArray src off len =
runST $ thawUnliftedArray src off len >>= unsafeFreezeUnliftedArray
cloneMutableUnliftedArray
:: (PrimMonad m)
=> MutableUnliftedArray (PrimState m) a
-> Int
-> Int
-> m (MutableUnliftedArray (PrimState m) a)
cloneMutableUnliftedArray src off len = do
dst <- unsafeNewUnliftedArray len
copyMutableUnliftedArray dst 0 src off len
return dst
instance Eq (MutableUnliftedArray s a) where
(==) = sameMutableUnliftedArray
instance (Eq a, PrimUnlifted a) => Eq (UnliftedArray a) where
aa1 == aa2 = sizeofUnliftedArray aa1 == sizeofUnliftedArray aa2
&& loop (sizeofUnliftedArray aa1 1)
where
loop i
| i < 0 = True
| otherwise = indexUnliftedArray aa1 i == indexUnliftedArray aa2 i && loop (i1)