{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples, UnliftedFFITypes, DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Data.Primitive.ByteArray
-- Copyright   : (c) Roman Leshchinskiy 2009-2012
-- License     : BSD-style
--
-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
-- Portability : non-portable
--
-- Primitive operations on ByteArrays
--

module Data.Primitive.ByteArray (
  -- * Types
  ByteArray(..), MutableByteArray(..), ByteArray#, MutableByteArray#,

  -- * Allocation
  newByteArray, newPinnedByteArray, newAlignedPinnedByteArray,
  resizeMutableByteArray,

  -- * Element access
  readByteArray, writeByteArray, indexByteArray,

  -- * Constructing
  byteArrayFromList, byteArrayFromListN,

  -- * Folding
  foldrByteArray,

  -- * Freezing and thawing
  unsafeFreezeByteArray, unsafeThawByteArray,

  -- * Block operations
  copyByteArray, copyMutableByteArray,
#if __GLASGOW_HASKELL__ >= 708
  copyByteArrayToAddr, copyMutableByteArrayToAddr,
#endif
  moveByteArray,
  setByteArray, fillByteArray,

  -- * Information
  sizeofByteArray,
  sizeofMutableByteArray, getSizeofMutableByteArray, sameMutableByteArray,
#if __GLASGOW_HASKELL__ >= 802
  isByteArrayPinned, isMutableByteArrayPinned,
#endif
  byteArrayContents, mutableByteArrayContents

) where

import Control.Monad.Primitive
import Control.Monad.ST
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.Exts
#if __GLASGOW_HASKELL__ >= 706
    hiding (setByteArray#)
#endif

import Data.Typeable ( Typeable )
import Data.Data ( Data(..) )
import Data.Primitive.Internal.Compat ( isTrue#, mkNoRepType )
import Numeric

#if MIN_VERSION_base(4,9,0)
import qualified Data.Semigroup as SG
import qualified Data.Foldable as F
#endif

#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid (Monoid(..))
#endif

#if __GLASGOW_HASKELL__ >= 802
import GHC.Exts as Exts (isByteArrayPinned#,isMutableByteArrayPinned#)
#endif

#if __GLASGOW_HASKELL__ >= 804
import GHC.Exts (compareByteArrays#)
#else
import System.IO.Unsafe (unsafeDupablePerformIO)
#endif

-- | Byte arrays
data ByteArray = ByteArray ByteArray# deriving ( Typeable )

-- | Mutable byte arrays associated with a primitive state token
data MutableByteArray s = MutableByteArray (MutableByteArray# s)
                                        deriving( Typeable )

-- | Create a new mutable byte array of the specified size in bytes.
newByteArray :: PrimMonad m => Int -> m (MutableByteArray (PrimState m))
{-# INLINE newByteArray #-}
newByteArray :: Int -> m (MutableByteArray (PrimState m))
newByteArray (I# n# :: Int#
n#)
  = (State# (PrimState m)
 -> (# State# (PrimState m), MutableByteArray (PrimState m) #))
-> m (MutableByteArray (PrimState m))
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\s# :: State# (PrimState m)
s# -> case Int#
-> State# (PrimState m)
-> (# State# (PrimState m), MutableByteArray# (PrimState m) #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
n# State# (PrimState m)
s# of
                        (# s'# :: State# (PrimState m)
s'#, arr# :: MutableByteArray# (PrimState m)
arr# #) -> (# State# (PrimState m)
s'#, MutableByteArray# (PrimState m) -> MutableByteArray (PrimState m)
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# (PrimState m)
arr# #))

-- | Create a /pinned/ byte array of the specified size in bytes. The garbage
-- collector is guaranteed not to move it.
newPinnedByteArray :: PrimMonad m => Int -> m (MutableByteArray (PrimState m))
{-# INLINE newPinnedByteArray #-}
newPinnedByteArray :: Int -> m (MutableByteArray (PrimState m))
newPinnedByteArray (I# n# :: Int#
n#)
  = (State# (PrimState m)
 -> (# State# (PrimState m), MutableByteArray (PrimState m) #))
-> m (MutableByteArray (PrimState m))
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\s# :: State# (PrimState m)
s# -> case Int#
-> State# (PrimState m)
-> (# State# (PrimState m), MutableByteArray# (PrimState m) #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newPinnedByteArray# Int#
n# State# (PrimState m)
s# of
                        (# s'# :: State# (PrimState m)
s'#, arr# :: MutableByteArray# (PrimState m)
arr# #) -> (# State# (PrimState m)
s'#, MutableByteArray# (PrimState m) -> MutableByteArray (PrimState m)
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# (PrimState m)
arr# #))

-- | Create a /pinned/ byte array of the specified size in bytes and with the
-- given alignment. The garbage collector is guaranteed not to move it.
newAlignedPinnedByteArray
  :: PrimMonad m
  => Int  -- ^ size
  -> Int  -- ^ alignment
  -> m (MutableByteArray (PrimState m))
{-# INLINE newAlignedPinnedByteArray #-}
newAlignedPinnedByteArray :: Int -> Int -> m (MutableByteArray (PrimState m))
newAlignedPinnedByteArray (I# n# :: Int#
n#) (I# k# :: Int#
k#)
  = (State# (PrimState m)
 -> (# State# (PrimState m), MutableByteArray (PrimState m) #))
-> m (MutableByteArray (PrimState m))
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\s# :: State# (PrimState m)
s# -> case Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), MutableByteArray# (PrimState m) #)
forall d.
Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newAlignedPinnedByteArray# Int#
n# Int#
k# State# (PrimState m)
s# of
                        (# s'# :: State# (PrimState m)
s'#, arr# :: MutableByteArray# (PrimState m)
arr# #) -> (# State# (PrimState m)
s'#, MutableByteArray# (PrimState m) -> MutableByteArray (PrimState m)
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# (PrimState m)
arr# #))

-- | Yield a pointer to the array's data. This operation is only safe on
-- /pinned/ byte arrays allocated by 'newPinnedByteArray' or
-- 'newAlignedPinnedByteArray'.
byteArrayContents :: ByteArray -> Ptr Word8
{-# INLINE byteArrayContents #-}
byteArrayContents :: ByteArray -> Ptr Word8
byteArrayContents (ByteArray arr# :: ByteArray#
arr#) = Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
arr#)

-- | Yield a pointer to the array's data. This operation is only safe on
-- /pinned/ byte arrays allocated by 'newPinnedByteArray' or
-- 'newAlignedPinnedByteArray'.
mutableByteArrayContents :: MutableByteArray s -> Ptr Word8
{-# INLINE mutableByteArrayContents #-}
mutableByteArrayContents :: MutableByteArray s -> Ptr Word8
mutableByteArrayContents (MutableByteArray arr# :: MutableByteArray# s
arr#)
  = Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# (MutableByteArray# s -> ByteArray#
unsafeCoerce# MutableByteArray# s
arr#))

-- | Check if the two arrays refer to the same memory block.
sameMutableByteArray :: MutableByteArray s -> MutableByteArray s -> Bool
{-# INLINE sameMutableByteArray #-}
sameMutableByteArray :: MutableByteArray s -> MutableByteArray s -> Bool
sameMutableByteArray (MutableByteArray arr# :: MutableByteArray# s
arr#) (MutableByteArray brr# :: MutableByteArray# s
brr#)
  = Int# -> Bool
isTrue# (MutableByteArray# s -> MutableByteArray# s -> Int#
forall d. MutableByteArray# d -> MutableByteArray# d -> Int#
sameMutableByteArray# MutableByteArray# s
arr# MutableByteArray# s
brr#)

-- | Resize a mutable byte array. The new size is given in bytes.
--
-- This will either resize the array in-place or, if not possible, allocate the
-- contents into a new, unpinned array and copy the original array's contents.
--
-- To avoid undefined behaviour, the original 'MutableByteArray' shall not be
-- accessed anymore after a 'resizeMutableByteArray' has been performed.
-- Moreover, no reference to the old one should be kept in order to allow
-- garbage collection of the original 'MutableByteArray' in case a new
-- 'MutableByteArray' had to be allocated.
--
-- @since 0.6.4.0
resizeMutableByteArray
  :: PrimMonad m => MutableByteArray (PrimState m) -> Int
                 -> m (MutableByteArray (PrimState m))
{-# INLINE resizeMutableByteArray #-}
#if __GLASGOW_HASKELL__ >= 710
resizeMutableByteArray :: MutableByteArray (PrimState m)
-> Int -> m (MutableByteArray (PrimState m))
resizeMutableByteArray (MutableByteArray arr# :: MutableByteArray# (PrimState m)
arr#) (I# n# :: Int#
n#)
  = (State# (PrimState m)
 -> (# State# (PrimState m), MutableByteArray (PrimState m) #))
-> m (MutableByteArray (PrimState m))
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\s# :: State# (PrimState m)
s# -> case MutableByteArray# (PrimState m)
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), MutableByteArray# (PrimState m) #)
forall d.
MutableByteArray# d
-> Int# -> State# d -> (# State# d, MutableByteArray# d #)
resizeMutableByteArray# MutableByteArray# (PrimState m)
arr# Int#
n# State# (PrimState m)
s# of
                        (# s'# :: State# (PrimState m)
s'#, arr'# :: MutableByteArray# (PrimState m)
arr'# #) -> (# State# (PrimState m)
s'#, MutableByteArray# (PrimState m) -> MutableByteArray (PrimState m)
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# (PrimState m)
arr'# #))
#else
resizeMutableByteArray arr n
  = do arr' <- newByteArray n
       copyMutableByteArray arr' 0 arr 0 (min (sizeofMutableByteArray arr) n)
       return arr'
#endif

-- | Get the size of a byte array in bytes. Unlike 'sizeofMutableByteArray',
-- this function ensures sequencing in the presence of resizing.
getSizeofMutableByteArray
  :: PrimMonad m => MutableByteArray (PrimState m) -> m Int
{-# INLINE getSizeofMutableByteArray #-}
#if __GLASGOW_HASKELL__ >= 801
getSizeofMutableByteArray :: MutableByteArray (PrimState m) -> m Int
getSizeofMutableByteArray (MutableByteArray arr# :: MutableByteArray# (PrimState m)
arr#)
  = (State# (PrimState m) -> (# State# (PrimState m), Int #)) -> m Int
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\s# :: State# (PrimState m)
s# -> case MutableByteArray# (PrimState m)
-> State# (PrimState m) -> (# State# (PrimState m), Int# #)
forall d. MutableByteArray# d -> State# d -> (# State# d, Int# #)
getSizeofMutableByteArray# MutableByteArray# (PrimState m)
arr# State# (PrimState m)
s# of
                        (# s'# :: State# (PrimState m)
s'#, n# :: Int#
n# #) -> (# State# (PrimState m)
s'#, Int# -> Int
I# Int#
n# #))
#else
getSizeofMutableByteArray arr
  = return (sizeofMutableByteArray arr)
#endif

-- | Convert a mutable byte array to an immutable one without copying. The
-- array should not be modified after the conversion.
unsafeFreezeByteArray
  :: PrimMonad m => MutableByteArray (PrimState m) -> m ByteArray
{-# INLINE unsafeFreezeByteArray #-}
unsafeFreezeByteArray :: MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray (MutableByteArray arr# :: MutableByteArray# (PrimState m)
arr#)
  = (State# (PrimState m) -> (# State# (PrimState m), ByteArray #))
-> m ByteArray
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\s# :: State# (PrimState m)
s# -> case MutableByteArray# (PrimState m)
-> State# (PrimState m) -> (# State# (PrimState m), ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# (PrimState m)
arr# State# (PrimState m)
s# of
                        (# s'# :: State# (PrimState m)
s'#, arr'# :: ByteArray#
arr'# #) -> (# State# (PrimState m)
s'#, ByteArray# -> ByteArray
ByteArray ByteArray#
arr'# #))

-- | Convert an immutable byte array to a mutable one without copying. The
-- original array should not be used after the conversion.
unsafeThawByteArray
  :: PrimMonad m => ByteArray -> m (MutableByteArray (PrimState m))
{-# INLINE unsafeThawByteArray #-}
unsafeThawByteArray :: ByteArray -> m (MutableByteArray (PrimState m))
unsafeThawByteArray (ByteArray arr# :: ByteArray#
arr#)
  = (State# (PrimState m)
 -> (# State# (PrimState m), MutableByteArray (PrimState m) #))
-> m (MutableByteArray (PrimState m))
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\s# :: State# (PrimState m)
s# -> (# State# (PrimState m)
s#, MutableByteArray# (PrimState m) -> MutableByteArray (PrimState m)
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray (ByteArray# -> MutableByteArray# (PrimState m)
unsafeCoerce# ByteArray#
arr#) #))

-- | Size of the byte array in bytes.
sizeofByteArray :: ByteArray -> Int
{-# INLINE sizeofByteArray #-}
sizeofByteArray :: ByteArray -> Int
sizeofByteArray (ByteArray arr# :: ByteArray#
arr#) = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
arr#)

-- | Size of the mutable byte array in bytes. This function\'s behavior
-- is undefined if 'resizeMutableByteArray' is ever called on the mutable
-- byte array given as the argument. Consequently, use of this function
-- is discouraged. Prefer 'getSizeofMutableByteArray', which ensures correct
-- sequencing in the presence of resizing.
sizeofMutableByteArray :: MutableByteArray s -> Int
{-# INLINE sizeofMutableByteArray #-}
sizeofMutableByteArray :: MutableByteArray s -> Int
sizeofMutableByteArray (MutableByteArray arr# :: MutableByteArray# s
arr#) = Int# -> Int
I# (MutableByteArray# s -> Int#
forall d. MutableByteArray# d -> Int#
sizeofMutableByteArray# MutableByteArray# s
arr#)

#if __GLASGOW_HASKELL__ >= 802
-- | Check whether or not the byte array is pinned. Pinned byte arrays cannot
--   be moved by the garbage collector. It is safe to use 'byteArrayContents'
--   on such byte arrays. This function is only available when compiling with
--   GHC 8.2 or newer.
--
--   @since 0.6.4.0
isByteArrayPinned :: ByteArray -> Bool
{-# INLINE isByteArrayPinned #-}
isByteArrayPinned :: ByteArray -> Bool
isByteArrayPinned (ByteArray arr# :: ByteArray#
arr#) = Int# -> Bool
isTrue# (ByteArray# -> Int#
Exts.isByteArrayPinned# ByteArray#
arr#)

-- | Check whether or not the mutable byte array is pinned. This function is
--   only available when compiling with GHC 8.2 or newer.
--
--   @since 0.6.4.0
isMutableByteArrayPinned :: MutableByteArray s -> Bool
{-# INLINE isMutableByteArrayPinned #-}
isMutableByteArrayPinned :: MutableByteArray s -> Bool
isMutableByteArrayPinned (MutableByteArray marr# :: MutableByteArray# s
marr#) = Int# -> Bool
isTrue# (MutableByteArray# s -> Int#
forall d. MutableByteArray# d -> Int#
Exts.isMutableByteArrayPinned# MutableByteArray# s
marr#)
#endif

-- | Read a primitive value from the byte array. The offset is given in
-- elements of type @a@ rather than in bytes.
indexByteArray :: Prim a => ByteArray -> Int -> a
{-# INLINE indexByteArray #-}
indexByteArray :: ByteArray -> Int -> a
indexByteArray (ByteArray arr# :: ByteArray#
arr#) (I# i# :: Int#
i#) = ByteArray# -> Int# -> a
forall a. Prim a => ByteArray# -> Int# -> a
indexByteArray# ByteArray#
arr# Int#
i#

-- | Read a primitive value from the byte array. The offset is given in
-- elements of type @a@ rather than in bytes.
readByteArray
  :: (Prim a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> m a
{-# INLINE readByteArray #-}
readByteArray :: MutableByteArray (PrimState m) -> Int -> m a
readByteArray (MutableByteArray arr# :: MutableByteArray# (PrimState m)
arr#) (I# i# :: Int#
i#)
  = (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (MutableByteArray# (PrimState m)
-> Int# -> State# (PrimState m) -> (# State# (PrimState m), a #)
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readByteArray# MutableByteArray# (PrimState m)
arr# Int#
i#)

-- | Write a primitive value to the byte array. The offset is given in
-- elements of type @a@ rather than in bytes.
writeByteArray
  :: (Prim a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> a -> m ()
{-# INLINE writeByteArray #-}
writeByteArray :: MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray (MutableByteArray arr# :: MutableByteArray# (PrimState m)
arr#) (I# i# :: Int#
i#) x :: a
x
  = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableByteArray# (PrimState m)
-> Int# -> a -> State# (PrimState m) -> State# (PrimState m)
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeByteArray# MutableByteArray# (PrimState m)
arr# Int#
i# a
x)

-- | Right-fold over the elements of a 'ByteArray'.
foldrByteArray :: forall a b. (Prim a) => (a -> b -> b) -> b -> ByteArray -> b
{-# INLINE foldrByteArray #-}
foldrByteArray :: (a -> b -> b) -> b -> ByteArray -> b
foldrByteArray f :: a -> b -> b
f z :: b
z arr :: ByteArray
arr = Int -> b
go 0
  where
    go :: Int -> b
go i :: Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxI  = a -> b -> b
f (ByteArray -> Int -> a
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr Int
i) (Int -> b
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1))
      | Bool
otherwise = b
z
    maxI :: Int
maxI = ByteArray -> Int
sizeofByteArray ByteArray
arr Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` a -> Int
forall a. Prim a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)

byteArrayFromList :: Prim a => [a] -> ByteArray
byteArrayFromList :: [a] -> ByteArray
byteArrayFromList xs :: [a]
xs = Int -> [a] -> ByteArray
forall a. Prim a => Int -> [a] -> ByteArray
byteArrayFromListN ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) [a]
xs

byteArrayFromListN :: Prim a => Int -> [a] -> ByteArray
byteArrayFromListN :: Int -> [a] -> ByteArray
byteArrayFromListN n :: Int
n ys :: [a]
ys = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray s
marr <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Prim a => a -> Int
sizeOf ([a] -> a
forall a. [a] -> a
head [a]
ys))
    let go :: Int -> [a] -> ST s ()
go !Int
ix [] = if Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
          then () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else String -> String -> ST s ()
forall a. String -> String -> a
die "byteArrayFromListN" "list length less than specified size"
        go !Int
ix (x :: a
x : xs :: [a]
xs) = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
          then do
            MutableByteArray (PrimState (ST s)) -> Int -> a -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr Int
ix a
x
            Int -> [a] -> ST s ()
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) [a]
xs
          else String -> String -> ST s ()
forall a. String -> String -> a
die "byteArrayFromListN" "list length greater than specified size"
    Int -> [a] -> ST s ()
go 0 [a]
ys
    MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr

unI# :: Int -> Int#
unI# :: Int -> Int#
unI# (I# n# :: Int#
n#) = Int#
n#

-- | Copy a slice of an immutable byte array to a mutable byte array.
copyByteArray
  :: PrimMonad m => MutableByteArray (PrimState m)
                                        -- ^ destination array
                 -> Int                 -- ^ offset into destination array
                 -> ByteArray           -- ^ source array
                 -> Int                 -- ^ offset into source array
                 -> Int                 -- ^ number of bytes to copy
                 -> m ()
{-# INLINE copyByteArray #-}
copyByteArray :: MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
copyByteArray (MutableByteArray dst# :: MutableByteArray# (PrimState m)
dst#) doff :: Int
doff (ByteArray src# :: ByteArray#
src#) soff :: Int
soff sz :: Int
sz
  = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (ByteArray#
-> Int#
-> MutableByteArray# (PrimState m)
-> Int#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
src# (Int -> Int#
unI# Int
soff) MutableByteArray# (PrimState m)
dst# (Int -> Int#
unI# Int
doff) (Int -> Int#
unI# Int
sz))

-- | Copy a slice of a mutable byte array into another array. The two slices
-- may not overlap.
copyMutableByteArray
  :: PrimMonad m => MutableByteArray (PrimState m)
                                        -- ^ destination array
                 -> Int                 -- ^ offset into destination array
                 -> MutableByteArray (PrimState m)
                                        -- ^ source array
                 -> Int                 -- ^ offset into source array
                 -> Int                 -- ^ number of bytes to copy
                 -> m ()
{-# INLINE copyMutableByteArray #-}
copyMutableByteArray :: MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray (MutableByteArray dst# :: MutableByteArray# (PrimState m)
dst#) doff :: Int
doff
                     (MutableByteArray src# :: MutableByteArray# (PrimState m)
src#) soff :: Int
soff sz :: Int
sz
  = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableByteArray# (PrimState m)
-> Int#
-> MutableByteArray# (PrimState m)
-> Int#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
forall d.
MutableByteArray# d
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableByteArray# MutableByteArray# (PrimState m)
src# (Int -> Int#
unI# Int
soff) MutableByteArray# (PrimState m)
dst# (Int -> Int#
unI# Int
doff) (Int -> Int#
unI# Int
sz))

#if __GLASGOW_HASKELL__ >= 708
-- | Copy a slice of a byte array to an unmanaged address. These must not
--   overlap. This function is only available when compiling with GHC 7.8
--   or newer.
--
--   @since 0.6.4.0
copyByteArrayToAddr
  :: PrimMonad m
  => Ptr Word8 -- ^ destination
  -> ByteArray -- ^ source array
  -> Int -- ^ offset into source array
  -> Int -- ^ number of bytes to copy
  -> m ()
{-# INLINE copyByteArrayToAddr #-}
copyByteArrayToAddr :: Ptr Word8 -> ByteArray -> Int -> Int -> m ()
copyByteArrayToAddr (Ptr dst# :: Addr#
dst#) (ByteArray src# :: ByteArray#
src#) soff :: Int
soff sz :: Int
sz
  = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (ByteArray#
-> Int#
-> Addr#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
copyByteArrayToAddr# ByteArray#
src# (Int -> Int#
unI# Int
soff) Addr#
dst# (Int -> Int#
unI# Int
sz))

-- | Copy a slice of a mutable byte array to an unmanaged address. These must
--   not overlap. This function is only available when compiling with GHC 7.8
--   or newer.
--
--   @since 0.6.4.0
copyMutableByteArrayToAddr
  :: PrimMonad m
  => Ptr Word8 -- ^ destination
  -> MutableByteArray (PrimState m) -- ^ source array
  -> Int -- ^ offset into source array
  -> Int -- ^ number of bytes to copy
  -> m ()
{-# INLINE copyMutableByteArrayToAddr #-}
copyMutableByteArrayToAddr :: Ptr Word8 -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArrayToAddr (Ptr dst# :: Addr#
dst#) (MutableByteArray src# :: MutableByteArray# (PrimState m)
src#) soff :: Int
soff sz :: Int
sz
  = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableByteArray# (PrimState m)
-> Int#
-> Addr#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
forall d.
MutableByteArray# d
-> Int# -> Addr# -> Int# -> State# d -> State# d
copyMutableByteArrayToAddr# MutableByteArray# (PrimState m)
src# (Int -> Int#
unI# Int
soff) Addr#
dst# (Int -> Int#
unI# Int
sz))
#endif

-- | Copy a slice of a mutable byte array into another, potentially
-- overlapping array.
moveByteArray
  :: PrimMonad m => MutableByteArray (PrimState m)
                                        -- ^ destination array
                 -> Int                 -- ^ offset into destination array
                 -> MutableByteArray (PrimState m)
                                        -- ^ source array
                 -> Int                 -- ^ offset into source array
                 -> Int                 -- ^ number of bytes to copy
                 -> m ()
{-# INLINE moveByteArray #-}
moveByteArray :: MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
moveByteArray (MutableByteArray dst# :: MutableByteArray# (PrimState m)
dst#) doff :: Int
doff
              (MutableByteArray src# :: MutableByteArray# (PrimState m)
src#) soff :: Int
soff sz :: Int
sz
  = IO () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim
  (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MutableByteArray# (PrimState m)
-> CInt
-> MutableByteArray# (PrimState m)
-> CInt
-> CSize
-> IO ()
forall s.
MutableByteArray# s
-> CInt -> MutableByteArray# s -> CInt -> CSize -> IO ()
memmove_mba MutableByteArray# (PrimState m)
dst# (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
doff) MutableByteArray# (PrimState m)
src# (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
soff)
                     (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)

-- | Fill a slice of a mutable byte array with a value. The offset and length
-- are given in elements of type @a@ rather than in bytes.
setByteArray
  :: (Prim a, PrimMonad m) => MutableByteArray (PrimState m) -- ^ array to fill
                           -> Int                 -- ^ offset into array
                           -> Int                 -- ^ number of values to fill
                           -> a                   -- ^ value to fill with
                           -> m ()
{-# INLINE setByteArray #-}
setByteArray :: MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray (MutableByteArray dst# :: MutableByteArray# (PrimState m)
dst#) (I# doff# :: Int#
doff#) (I# sz# :: Int#
sz#) x :: a
x
  = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableByteArray# (PrimState m)
-> Int#
-> Int#
-> a
-> State# (PrimState m)
-> State# (PrimState m)
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
setByteArray# MutableByteArray# (PrimState m)
dst# Int#
doff# Int#
sz# a
x)

-- | Fill a slice of a mutable byte array with a byte.
fillByteArray
  :: PrimMonad m => MutableByteArray (PrimState m)
                                        -- ^ array to fill
                 -> Int                 -- ^ offset into array
                 -> Int                 -- ^ number of bytes to fill
                 -> Word8               -- ^ byte to fill with
                 -> m ()
{-# INLINE fillByteArray #-}
fillByteArray :: MutableByteArray (PrimState m) -> Int -> Int -> Word8 -> m ()
fillByteArray = MutableByteArray (PrimState m) -> Int -> Int -> Word8 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray

foreign import ccall unsafe "primitive-memops.h hsprimitive_memmove"
  memmove_mba :: MutableByteArray# s -> CInt
              -> MutableByteArray# s -> CInt
              -> CSize -> IO ()

instance Data ByteArray where
  toConstr :: ByteArray -> Constr
toConstr _ = String -> Constr
forall a. HasCallStack => String -> a
error "toConstr"
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ByteArray
gunfold _ _ = String -> Constr -> c ByteArray
forall a. HasCallStack => String -> a
error "gunfold"
  dataTypeOf :: ByteArray -> DataType
dataTypeOf _ = String -> DataType
mkNoRepType "Data.Primitive.ByteArray.ByteArray"

instance Typeable s => Data (MutableByteArray s) where
  toConstr :: MutableByteArray s -> Constr
toConstr _ = String -> Constr
forall a. HasCallStack => String -> a
error "toConstr"
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (MutableByteArray s)
gunfold _ _ = String -> Constr -> c (MutableByteArray s)
forall a. HasCallStack => String -> a
error "gunfold"
  dataTypeOf :: MutableByteArray s -> DataType
dataTypeOf _ = String -> DataType
mkNoRepType "Data.Primitive.ByteArray.MutableByteArray"

-- | @since 0.6.3.0
instance Show ByteArray where
  showsPrec :: Int -> ByteArray -> ShowS
showsPrec _ ba :: ByteArray
ba =
      String -> ShowS
showString "[" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
go 0
    where
      go :: Int -> ShowS
go i :: Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteArray -> Int
sizeofByteArray ByteArray
ba = ShowS
comma ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString "0x" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
ba Int
i :: Word8) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
        | Bool
otherwise              = Char -> ShowS
showChar ']'
        where
          comma :: ShowS
comma | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0    = ShowS
forall a. a -> a
id
                | Bool
otherwise = String -> ShowS
showString ", "


compareByteArrays :: ByteArray -> ByteArray -> Int -> Ordering
{-# INLINE compareByteArrays #-}
#if __GLASGOW_HASKELL__ >= 804
compareByteArrays :: ByteArray -> ByteArray -> Int -> Ordering
compareByteArrays (ByteArray ba1# :: ByteArray#
ba1#) (ByteArray ba2# :: ByteArray#
ba2#) (I# n# :: Int#
n#) =
  Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int# -> Int
I# (ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#
compareByteArrays# ByteArray#
ba1# 0# ByteArray#
ba2# 0# Int#
n#)) 0
#else
-- Emulate GHC 8.4's 'GHC.Prim.compareByteArrays#'
compareByteArrays (ByteArray ba1#) (ByteArray ba2#) (I# n#)
    = compare (fromCInt (unsafeDupablePerformIO (memcmp_ba ba1# ba2# n))) 0
  where
    n = fromIntegral (I# n#) :: CSize
    fromCInt = fromIntegral :: CInt -> Int

foreign import ccall unsafe "primitive-memops.h hsprimitive_memcmp"
  memcmp_ba :: ByteArray# -> ByteArray# -> CSize -> IO CInt
#endif


sameByteArray :: ByteArray# -> ByteArray# -> Bool
sameByteArray :: ByteArray# -> ByteArray# -> Bool
sameByteArray ba1 :: ByteArray#
ba1 ba2 :: ByteArray#
ba2 =
    case () -> () -> Int#
forall k1. k1 -> k1 -> Int#
reallyUnsafePtrEquality# (ByteArray# -> ()
unsafeCoerce# ByteArray#
ba1 :: ()) (ByteArray# -> ()
unsafeCoerce# ByteArray#
ba2 :: ()) of
#if __GLASGOW_HASKELL__ >= 708
      r :: Int#
r -> Int# -> Bool
isTrue# Int#
r
#else
      1# -> True
      0# -> False
#endif

-- | @since 0.6.3.0
instance Eq ByteArray where
  ba1 :: ByteArray
ba1@(ByteArray ba1# :: ByteArray#
ba1#) == :: ByteArray -> ByteArray -> Bool
== ba2 :: ByteArray
ba2@(ByteArray ba2# :: ByteArray#
ba2#)
    | ByteArray# -> ByteArray# -> Bool
sameByteArray ByteArray#
ba1# ByteArray#
ba2# = Bool
True
    | Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n2 = Bool
False
    | Bool
otherwise = ByteArray -> ByteArray -> Int -> Ordering
compareByteArrays ByteArray
ba1 ByteArray
ba2 Int
n1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
    where
      n1 :: Int
n1 = ByteArray -> Int
sizeofByteArray ByteArray
ba1
      n2 :: Int
n2 = ByteArray -> Int
sizeofByteArray ByteArray
ba2

-- | Non-lexicographic ordering. This compares the lengths of
-- the byte arrays first and uses a lexicographic ordering if
-- the lengths are equal. Subject to change between major versions.
--
-- @since 0.6.3.0
instance Ord ByteArray where
  ba1 :: ByteArray
ba1@(ByteArray ba1# :: ByteArray#
ba1#) compare :: ByteArray -> ByteArray -> Ordering
`compare` ba2 :: ByteArray
ba2@(ByteArray ba2# :: ByteArray#
ba2#)
    | ByteArray# -> ByteArray# -> Bool
sameByteArray ByteArray#
ba1# ByteArray#
ba2# = Ordering
EQ
    | Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n2 = Int
n1 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
n2
    | Bool
otherwise = ByteArray -> ByteArray -> Int -> Ordering
compareByteArrays ByteArray
ba1 ByteArray
ba2 Int
n1
    where
      n1 :: Int
n1 = ByteArray -> Int
sizeofByteArray ByteArray
ba1
      n2 :: Int
n2 = ByteArray -> Int
sizeofByteArray ByteArray
ba2
-- Note: On GHC 8.4, the primop compareByteArrays# performs a check for pointer
-- equality as a shortcut, so the check here is actually redundant. However, it
-- is included here because it is likely better to check for pointer equality
-- before checking for length equality. Getting the length requires deferencing
-- the pointers, which could cause accesses to memory that is not in the cache.
-- By contrast, a pointer equality check is always extremely cheap.

appendByteArray :: ByteArray -> ByteArray -> ByteArray
appendByteArray :: ByteArray -> ByteArray -> ByteArray
appendByteArray a :: ByteArray
a b :: ByteArray
b = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
  MutableByteArray s
marr <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (ByteArray -> Int
sizeofByteArray ByteArray
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteArray -> Int
sizeofByteArray ByteArray
b)
  MutableByteArray (PrimState (ST s))
-> Int -> ByteArray -> Int -> Int -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
copyByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr 0 ByteArray
a 0 (ByteArray -> Int
sizeofByteArray ByteArray
a)
  MutableByteArray (PrimState (ST s))
-> Int -> ByteArray -> Int -> Int -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
copyByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr (ByteArray -> Int
sizeofByteArray ByteArray
a) ByteArray
b 0 (ByteArray -> Int
sizeofByteArray ByteArray
b)
  MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr

concatByteArray :: [ByteArray] -> ByteArray
concatByteArray :: [ByteArray] -> ByteArray
concatByteArray arrs :: [ByteArray]
arrs = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
  let len :: Int
len = [ByteArray] -> Int -> Int
calcLength [ByteArray]
arrs 0
  MutableByteArray s
marr <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
len
  MutableByteArray s -> Int -> [ByteArray] -> ST s ()
forall s. MutableByteArray s -> Int -> [ByteArray] -> ST s ()
pasteByteArrays MutableByteArray s
marr 0 [ByteArray]
arrs
  MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr

pasteByteArrays :: MutableByteArray s -> Int -> [ByteArray] -> ST s ()
pasteByteArrays :: MutableByteArray s -> Int -> [ByteArray] -> ST s ()
pasteByteArrays !MutableByteArray s
_ !Int
_ [] = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
pasteByteArrays !MutableByteArray s
marr !Int
ix (x :: ByteArray
x : xs :: [ByteArray]
xs) = do
  MutableByteArray (PrimState (ST s))
-> Int -> ByteArray -> Int -> Int -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
copyByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr Int
ix ByteArray
x 0 (ByteArray -> Int
sizeofByteArray ByteArray
x)
  MutableByteArray s -> Int -> [ByteArray] -> ST s ()
forall s. MutableByteArray s -> Int -> [ByteArray] -> ST s ()
pasteByteArrays MutableByteArray s
marr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteArray -> Int
sizeofByteArray ByteArray
x) [ByteArray]
xs

calcLength :: [ByteArray] -> Int -> Int
calcLength :: [ByteArray] -> Int -> Int
calcLength [] !Int
n = Int
n
calcLength (x :: ByteArray
x : xs :: [ByteArray]
xs) !Int
n = [ByteArray] -> Int -> Int
calcLength [ByteArray]
xs (ByteArray -> Int
sizeofByteArray ByteArray
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)

emptyByteArray :: ByteArray
emptyByteArray :: ByteArray
emptyByteArray = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST (Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray 0 ST s (MutableByteArray s)
-> (MutableByteArray s -> ST s ByteArray) -> ST s ByteArray
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutableByteArray s -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray)

replicateByteArray :: Int -> ByteArray -> ByteArray
replicateByteArray :: Int -> ByteArray -> ByteArray
replicateByteArray n :: Int
n arr :: ByteArray
arr = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
  MutableByteArray s
marr <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* ByteArray -> Int
sizeofByteArray ByteArray
arr)
  let go :: Int -> ST s ()
go i :: Int
i = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
        then do
          MutableByteArray (PrimState (ST s))
-> Int -> ByteArray -> Int -> Int -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
copyByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* ByteArray -> Int
sizeofByteArray ByteArray
arr) ByteArray
arr 0 (ByteArray -> Int
sizeofByteArray ByteArray
arr)
          Int -> ST s ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
        else () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Int -> ST s ()
go 0
  MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr

#if MIN_VERSION_base(4,9,0)
instance SG.Semigroup ByteArray where
  <> :: ByteArray -> ByteArray -> ByteArray
(<>) = ByteArray -> ByteArray -> ByteArray
appendByteArray
  sconcat :: NonEmpty ByteArray -> ByteArray
sconcat = [ByteArray] -> ByteArray
forall a. Monoid a => [a] -> a
mconcat ([ByteArray] -> ByteArray)
-> (NonEmpty ByteArray -> [ByteArray])
-> NonEmpty ByteArray
-> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ByteArray -> [ByteArray]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
  stimes :: b -> ByteArray -> ByteArray
stimes i :: b
i arr :: ByteArray
arr
    | Integer
itgr Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = ByteArray
emptyByteArray
    | Integer
itgr Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)) = Int -> ByteArray -> ByteArray
replicateByteArray (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
itgr) ByteArray
arr
    | Bool
otherwise = String -> ByteArray
forall a. HasCallStack => String -> a
error "Data.Primitive.ByteArray#stimes: cannot allocate the requested amount of memory"
    where itgr :: Integer
itgr = b -> Integer
forall a. Integral a => a -> Integer
toInteger b
i :: Integer
#endif

instance Monoid ByteArray where
  mempty :: ByteArray
mempty = ByteArray
emptyByteArray
#if !(MIN_VERSION_base(4,11,0))
  mappend = appendByteArray
#endif
  mconcat :: [ByteArray] -> ByteArray
mconcat = [ByteArray] -> ByteArray
concatByteArray

#if __GLASGOW_HASKELL__ >= 708
-- | @since 0.6.3.0
instance Exts.IsList ByteArray where
  type Item ByteArray = Word8

  toList :: ByteArray -> [Item ByteArray]
toList = (Word8 -> [Word8] -> [Word8]) -> [Word8] -> ByteArray -> [Word8]
forall a b. Prim a => (a -> b -> b) -> b -> ByteArray -> b
foldrByteArray (:) []
  fromList :: [Item ByteArray] -> ByteArray
fromList xs :: [Item ByteArray]
xs = Int -> [Word8] -> ByteArray
forall a. Prim a => Int -> [a] -> ByteArray
byteArrayFromListN ([Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
[Item ByteArray]
xs) [Word8]
[Item ByteArray]
xs
  fromListN :: Int -> [Item ByteArray] -> ByteArray
fromListN = Int -> [Item ByteArray] -> ByteArray
forall a. Prim a => Int -> [a] -> ByteArray
byteArrayFromListN
#endif

die :: String -> String -> a
die :: String -> String -> a
die fun :: String
fun problem :: String
problem = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "Data.Primitive.ByteArray." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fun String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
problem