module Data.Primitive.ByteArray (
ByteArray(..), MutableByteArray(..), ByteArray#, MutableByteArray#,
newByteArray, newPinnedByteArray, newAlignedPinnedByteArray,
readByteArray, writeByteArray, indexByteArray,
foldrByteArray,
unsafeFreezeByteArray, unsafeThawByteArray,
copyByteArray, copyMutableByteArray, moveByteArray,
setByteArray, fillByteArray,
sizeofByteArray, sizeofMutableByteArray, sameMutableByteArray,
byteArrayContents, mutableByteArrayContents
) where
import Control.Monad.Primitive
import Control.Monad.ST
import Control.Monad ( zipWithM_ )
import Data.Primitive.Types
import Foreign.C.Types
import Data.Word ( Word8 )
import GHC.Base ( Int(..) )
#if __GLASGOW_HASKELL__ >= 708
import qualified GHC.Exts as Exts ( IsList(..) )
#endif
import GHC.Prim
#if __GLASGOW_HASKELL__ >= 706
hiding (setByteArray#)
#endif
import Data.Typeable ( Typeable )
import Data.Data ( Data(..) )
import Data.Primitive.Internal.Compat ( isTrue#, mkNoRepType )
import Numeric
import System.IO.Unsafe
data ByteArray = ByteArray ByteArray# deriving ( Typeable )
data MutableByteArray s = MutableByteArray (MutableByteArray# s)
deriving( Typeable )
newByteArray :: PrimMonad m => Int -> m (MutableByteArray (PrimState m))
newByteArray (I# n#)
= primitive (\s# -> case newByteArray# n# s# of
(# s'#, arr# #) -> (# s'#, MutableByteArray arr# #))
newPinnedByteArray :: PrimMonad m => Int -> m (MutableByteArray (PrimState m))
newPinnedByteArray (I# n#)
= primitive (\s# -> case newPinnedByteArray# n# s# of
(# s'#, arr# #) -> (# s'#, MutableByteArray arr# #))
newAlignedPinnedByteArray
:: PrimMonad m => Int -> Int -> m (MutableByteArray (PrimState m))
newAlignedPinnedByteArray (I# n#) (I# k#)
= primitive (\s# -> case newAlignedPinnedByteArray# n# k# s# of
(# s'#, arr# #) -> (# s'#, MutableByteArray arr# #))
byteArrayContents :: ByteArray -> Addr
byteArrayContents (ByteArray arr#) = Addr (byteArrayContents# arr#)
mutableByteArrayContents :: MutableByteArray s -> Addr
mutableByteArrayContents (MutableByteArray arr#)
= Addr (byteArrayContents# (unsafeCoerce# arr#))
sameMutableByteArray :: MutableByteArray s -> MutableByteArray s -> Bool
sameMutableByteArray (MutableByteArray arr#) (MutableByteArray brr#)
= isTrue# (sameMutableByteArray# arr# brr#)
unsafeFreezeByteArray
:: PrimMonad m => MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray (MutableByteArray arr#)
= primitive (\s# -> case unsafeFreezeByteArray# arr# s# of
(# s'#, arr'# #) -> (# s'#, ByteArray arr'# #))
unsafeThawByteArray
:: PrimMonad m => ByteArray -> m (MutableByteArray (PrimState m))
unsafeThawByteArray (ByteArray arr#)
= primitive (\s# -> (# s#, MutableByteArray (unsafeCoerce# arr#) #))
sizeofByteArray :: ByteArray -> Int
sizeofByteArray (ByteArray arr#) = I# (sizeofByteArray# arr#)
sizeofMutableByteArray :: MutableByteArray s -> Int
sizeofMutableByteArray (MutableByteArray arr#) = I# (sizeofMutableByteArray# arr#)
indexByteArray :: Prim a => ByteArray -> Int -> a
indexByteArray (ByteArray arr#) (I# i#) = indexByteArray# arr# i#
readByteArray
:: (Prim a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> m a
readByteArray (MutableByteArray arr#) (I# i#)
= primitive (readByteArray# arr# i#)
writeByteArray
:: (Prim a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray (MutableByteArray arr#) (I# i#) x
= primitive_ (writeByteArray# arr# i# x)
foldrByteArray :: forall a b. (Prim a) => (a -> b -> b) -> b -> ByteArray -> b
foldrByteArray f z arr = go 0
where
go i
| sizeofByteArray arr > i * sz = f (indexByteArray arr i) (go (i+1))
| otherwise = z
sz = sizeofByteArray arr
fromListN :: Prim a => Int -> [a] -> ByteArray
fromListN n xs = runST $ do
marr <- newByteArray (n * sizeOf (head xs))
zipWithM_ (writeByteArray marr) [0..n] xs
unsafeFreezeByteArray marr
#if __GLASGOW_HASKELL__ >= 702
unI# :: Int -> Int#
unI# (I# n#) = n#
#endif
copyByteArray
:: PrimMonad m => MutableByteArray (PrimState m)
-> Int
-> ByteArray
-> Int
-> Int
-> m ()
copyByteArray (MutableByteArray dst#) doff (ByteArray src#) soff sz
#if __GLASGOW_HASKELL__ >= 702
= primitive_ (copyByteArray# src# (unI# soff) dst# (unI# doff) (unI# sz))
#else
= unsafePrimToPrim
$ memcpy_ba dst# (fromIntegral doff) src# (fromIntegral soff)
(fromIntegral sz)
#endif
copyMutableByteArray
:: PrimMonad m => MutableByteArray (PrimState m)
-> Int
-> MutableByteArray (PrimState m)
-> Int
-> Int
-> m ()
copyMutableByteArray (MutableByteArray dst#) doff
(MutableByteArray src#) soff sz
#if __GLASGOW_HASKELL__ >= 702
= primitive_ (copyMutableByteArray# src# (unI# soff) dst# (unI# doff) (unI# sz))
#else
= unsafePrimToPrim
$ memcpy_mba dst# (fromIntegral doff) src# (fromIntegral soff)
(fromIntegral sz)
#endif
moveByteArray
:: PrimMonad m => MutableByteArray (PrimState m)
-> Int
-> MutableByteArray (PrimState m)
-> Int
-> Int
-> m ()
moveByteArray (MutableByteArray dst#) doff
(MutableByteArray src#) soff sz
= unsafePrimToPrim
$ memmove_mba dst# (fromIntegral doff) src# (fromIntegral soff)
(fromIntegral sz)
setByteArray
:: (Prim a, PrimMonad m) => MutableByteArray (PrimState m)
-> Int
-> Int
-> a
-> m ()
setByteArray (MutableByteArray dst#) (I# doff#) (I# sz#) x
= primitive_ (setByteArray# dst# doff# sz# x)
fillByteArray
:: PrimMonad m => MutableByteArray (PrimState m)
-> Int
-> Int
-> Word8
-> m ()
fillByteArray = setByteArray
#if __GLASGOW_HASKELL__ < 702
foreign import ccall unsafe "primitive-memops.h hsprimitive_memcpy"
memcpy_mba :: MutableByteArray# s -> CInt
-> MutableByteArray# s -> CInt
-> CSize -> IO ()
foreign import ccall unsafe "primitive-memops.h hsprimitive_memcpy"
memcpy_ba :: MutableByteArray# s -> CInt
-> ByteArray# -> CInt
-> CSize -> IO ()
#endif
foreign import ccall unsafe "primitive-memops.h hsprimitive_memmove"
memmove_mba :: MutableByteArray# s -> CInt
-> MutableByteArray# s -> CInt
-> CSize -> IO ()
instance Data ByteArray where
toConstr _ = error "toConstr"
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "Data.Primitive.ByteArray.ByteArray"
instance Typeable s => Data (MutableByteArray s) where
toConstr _ = error "toConstr"
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "Data.Primitive.ByteArray.MutableByteArray"
instance Show ByteArray where
showsPrec _ ba =
showString "[" . go 0
where
go i
| i < sizeofByteArray ba = comma . showString "0x" . showHex (indexByteArray ba i :: Word8) . go (i+1)
| otherwise = showChar ']'
where
comma | i == 0 = id
| otherwise = showString ", "
foreign import ccall unsafe "primitive-memops.h hsprimitive_memcmp"
memcmp_ba :: ByteArray# -> ByteArray# -> CSize -> IO CInt
sameByteArray :: ByteArray# -> ByteArray# -> Bool
sameByteArray ba1 ba2 =
case reallyUnsafePtrEquality# (unsafeCoerce# ba1 :: ()) (unsafeCoerce# ba2 :: ()) of
#if __GLASGOW_HASKELL__ >= 708
r -> isTrue# r
#else
1# -> True
0# -> False
#endif
instance Eq ByteArray where
ba1@(ByteArray ba1#) == ba2@(ByteArray ba2#)
| sameByteArray ba1# ba2# = True
| sizeofByteArray ba1 /= sizeofByteArray ba2 = False
| otherwise =
case unsafeDupablePerformIO $ memcmp_ba ba1# ba2# (fromIntegral $ sizeofByteArray ba1) of
0 -> True
_ -> False
instance Ord ByteArray where
ba1@(ByteArray ba1#) `compare` ba2@(ByteArray ba2#)
| sameByteArray ba1# ba2# = EQ
| n1 /= n2 = n1 `compare` n2
| otherwise =
case unsafeDupablePerformIO $ memcmp_ba ba1# ba2# (fromIntegral n1) of
x | x > 0 -> GT
| x == 0 -> EQ
| otherwise -> LT
where
n1 = sizeofByteArray ba1
n2 = sizeofByteArray ba2
#if __GLASGOW_HASKELL__ >= 708
instance Exts.IsList ByteArray where
type Item ByteArray = Word8
toList = foldrByteArray (:) []
fromList xs = fromListN (length xs) xs
fromListN = fromListN
#endif