{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedFFITypes #-}
module Data.Array.Byte (
ByteArray(..),
MutableByteArray(..),
) where
import Data.Bits ((.&.), unsafeShiftR)
import Data.Data (mkNoRepType, Data(..), Typeable)
import qualified Data.Foldable as F
import Data.Semigroup (Semigroup(..))
import GHC.Exts (ByteArray#, MutableByteArray#, sameMutableByteArray#, isTrue#, unsafeCoerce#, reallyUnsafePtrEquality#, copyByteArray#, writeWord8Array#, indexWord8Array#, sizeofByteArray#, unsafeFreezeByteArray#, newByteArray#, IsList(..), Int(..))
import GHC.Show (intToDigit)
import GHC.ST (ST(..), runST)
import GHC.Word (Word8(..))
#if MIN_VERSION_base(4,11,0)
import GHC.Exts (compareByteArrays#)
#else
import Foreign.C.Types (CInt(..), CSize(..))
import System.IO.Unsafe (unsafeDupablePerformIO)
#endif
import Control.DeepSeq (NFData(..))
import GHC.Exts (Addr#, copyAddrToByteArray#)
import Language.Haskell.TH.Syntax (Lift(..), Lit(..), Exp(..))
#if MIN_VERSION_template_haskell(2,17,0)
import Language.Haskell.TH.Syntax (unsafeCodeCoerce)
#elif MIN_VERSION_template_haskell(2,16,0)
import Language.Haskell.TH.Syntax (unsafeTExpCoerce)
#endif
#if MIN_VERSION_template_haskell(2,16,0)
import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..))
import GHC.Exts (newPinnedByteArray#, isByteArrayPinned#, byteArrayContents#)
import Language.Haskell.TH.Syntax (Bytes(..))
#endif
data ByteArray = ByteArray ByteArray#
data MutableByteArray s = MutableByteArray (MutableByteArray# s)
newByteArray :: Int -> ST s (MutableByteArray s)
{-# INLINE newByteArray #-}
newByteArray :: forall s. Int -> ST s (MutableByteArray s)
newByteArray (I# Int#
n#) =
forall s a. STRep s a -> ST s a
ST (\State# s
s# -> case forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
n# State# s
s# of
(# State# s
s'#, MutableByteArray# s
arr# #) -> (# State# s
s'#, forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
arr# #))
unsafeFreezeByteArray :: MutableByteArray s -> ST s ByteArray
{-# INLINE unsafeFreezeByteArray #-}
unsafeFreezeByteArray :: forall s. MutableByteArray s -> ST s ByteArray
unsafeFreezeByteArray (MutableByteArray MutableByteArray# s
arr#) =
forall s a. STRep s a -> ST s a
ST (\State# s
s# -> case forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
arr# State# s
s# of
(# State# s
s'#, ByteArray#
arr'# #) -> (# State# s
s'#, ByteArray# -> ByteArray
ByteArray ByteArray#
arr'# #))
sizeofByteArray :: ByteArray -> Int
{-# INLINE sizeofByteArray #-}
sizeofByteArray :: ByteArray -> Int
sizeofByteArray (ByteArray ByteArray#
arr#) = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
arr#)
indexByteArray :: ByteArray -> Int -> Word8
{-# INLINE indexByteArray #-}
indexByteArray :: ByteArray -> Int -> Word8
indexByteArray (ByteArray ByteArray#
arr#) (I# Int#
i#) = Word8# -> Word8
W8# (ByteArray# -> Int# -> Word8#
indexWord8Array# ByteArray#
arr# Int#
i#)
writeByteArray :: MutableByteArray s -> Int -> Word8 -> ST s ()
{-# INLINE writeByteArray #-}
writeByteArray :: forall s. MutableByteArray s -> Int -> Word8 -> ST s ()
writeByteArray (MutableByteArray MutableByteArray# s
arr#) (I# Int#
i#) (W8# Word8#
x#) =
forall s a. STRep s a -> ST s a
ST (\State# s
s# -> case forall d.
MutableByteArray# d -> Int# -> Word8# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
arr# Int#
i# Word8#
x# State# s
s# of
State# s
s'# -> (# State# s
s'#, () #))
byteArrayToList :: ByteArray -> [Word8]
{-# INLINE byteArrayToList #-}
byteArrayToList :: ByteArray -> [Word8]
byteArrayToList ByteArray
arr = Int -> [Word8]
go Int
0
where
go :: Int -> [Word8]
go Int
i
| Int
i forall a. Ord a => a -> a -> Bool
< Int
maxI = ByteArray -> Int -> Word8
indexByteArray ByteArray
arr Int
i forall a. a -> [a] -> [a]
: Int -> [Word8]
go (Int
iforall a. Num a => a -> a -> a
+Int
1)
| Bool
otherwise = []
maxI :: Int
maxI = ByteArray -> Int
sizeofByteArray ByteArray
arr
byteArrayFromListN :: Int -> [Word8] -> ByteArray
byteArrayFromListN :: Int -> [Word8] -> ByteArray
byteArrayFromListN Int
n [Word8]
ys = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
MutableByteArray s
marr <- forall s. Int -> ST s (MutableByteArray s)
newByteArray Int
n
let go :: Int -> [Word8] -> ST s ()
go !Int
ix [] = if Int
ix forall a. Eq a => a -> a -> Bool
== Int
n
then forall (m :: * -> *) a. Monad m => a -> m a
return ()
else forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Array.Byte.byteArrayFromListN: list length less than specified size"
go !Int
ix (Word8
x : [Word8]
xs) = if Int
ix forall a. Ord a => a -> a -> Bool
< Int
n
then do
forall s. MutableByteArray s -> Int -> Word8 -> ST s ()
writeByteArray MutableByteArray s
marr Int
ix Word8
x
Int -> [Word8] -> ST s ()
go (Int
ix forall a. Num a => a -> a -> a
+ Int
1) [Word8]
xs
else forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Array.Byte.byteArrayFromListN: list length greater than specified size"
Int -> [Word8] -> ST s ()
go Int
0 [Word8]
ys
forall s. MutableByteArray s -> ST s ByteArray
unsafeFreezeByteArray MutableByteArray s
marr
copyByteArray
:: MutableByteArray s
-> Int
-> ByteArray
-> Int
-> Int
-> ST s ()
{-# INLINE copyByteArray #-}
copyByteArray :: forall s.
MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s ()
copyByteArray (MutableByteArray MutableByteArray# s
dst#) (I# Int#
doff#) (ByteArray ByteArray#
src#) (I# Int#
soff#) (I# Int#
sz#) =
forall s a. STRep s a -> ST s a
ST (\State# s
s# -> case forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
src# Int#
soff# MutableByteArray# s
dst# Int#
doff# Int#
sz# State# s
s# of
State# s
s'# -> (# State# s
s'#, () #))
instance Data ByteArray where
toConstr :: ByteArray -> Constr
toConstr ByteArray
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"toConstr"
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ByteArray
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
dataTypeOf :: ByteArray -> DataType
dataTypeOf ByteArray
_ = [Char] -> DataType
mkNoRepType [Char]
"Data.Array.Byte.ByteArray"
instance Typeable s => Data (MutableByteArray s) where
toConstr :: MutableByteArray s -> Constr
toConstr MutableByteArray s
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"toConstr"
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (MutableByteArray s)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
dataTypeOf :: MutableByteArray s -> DataType
dataTypeOf MutableByteArray s
_ = [Char] -> DataType
mkNoRepType [Char]
"Data.Array.Byte.MutableByteArray"
instance Show ByteArray where
showsPrec :: Int -> ByteArray -> ShowS
showsPrec Int
_ ByteArray
ba =
[Char] -> ShowS
showString [Char]
"[" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
go Int
0
where
showW8 :: Word8 -> String -> String
showW8 :: Word8 -> ShowS
showW8 !Word8
w [Char]
s =
Char
'0'
forall a. a -> [a] -> [a]
: Char
'x'
forall a. a -> [a] -> [a]
: Int -> Char
intToDigit (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
unsafeShiftR Word8
w Int
4))
forall a. a -> [a] -> [a]
: Int -> Char
intToDigit (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w forall a. Bits a => a -> a -> a
.&. Word8
0x0F))
forall a. a -> [a] -> [a]
: [Char]
s
go :: Int -> ShowS
go Int
i
| Int
i forall a. Ord a => a -> a -> Bool
< ByteArray -> Int
sizeofByteArray ByteArray
ba = ShowS
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ShowS
showW8 (ByteArray -> Int -> Word8
indexByteArray ByteArray
ba Int
i :: Word8) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
go (Int
iforall a. Num a => a -> a -> a
+Int
1)
| Bool
otherwise = Char -> ShowS
showChar Char
']'
where
comma :: ShowS
comma | Int
i forall a. Eq a => a -> a -> Bool
== Int
0 = forall a. a -> a
id
| Bool
otherwise = [Char] -> ShowS
showString [Char]
", "
compareByteArraysFromBeginning :: ByteArray -> ByteArray -> Int -> Ordering
{-# INLINE compareByteArraysFromBeginning #-}
#if MIN_VERSION_base(4,11,0)
compareByteArraysFromBeginning :: ByteArray -> ByteArray -> Int -> Ordering
compareByteArraysFromBeginning (ByteArray ByteArray#
ba1#) (ByteArray ByteArray#
ba2#) (I# Int#
n#)
= forall a. Ord a => a -> a -> Ordering
compare (Int# -> Int
I# (ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#
compareByteArrays# ByteArray#
ba1# Int#
0# ByteArray#
ba2# Int#
0# Int#
n#)) Int
0
#else
compareByteArraysFromBeginning (ByteArray ba1#) (ByteArray ba2#) (I# n#)
= compare (fromCInt (unsafeDupablePerformIO (memcmp ba1# ba2# n))) 0
where
n = fromIntegral (I# n#) :: CSize
fromCInt = fromIntegral :: CInt -> Int
foreign import ccall unsafe "memcmp"
memcmp :: ByteArray# -> ByteArray# -> CSize -> IO CInt
#endif
sameByteArray :: ByteArray# -> ByteArray# -> Bool
sameByteArray :: ByteArray# -> ByteArray# -> Bool
sameByteArray ByteArray#
ba1 ByteArray#
ba2 =
case forall a. a -> a -> Int#
reallyUnsafePtrEquality# (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# ByteArray#
ba1 :: ()) (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# ByteArray#
ba2 :: ()) of
Int#
r -> Int# -> Bool
isTrue# Int#
r
instance Eq ByteArray where
ba1 :: ByteArray
ba1@(ByteArray ByteArray#
ba1#) == :: ByteArray -> ByteArray -> Bool
== ba2 :: ByteArray
ba2@(ByteArray ByteArray#
ba2#)
| ByteArray# -> ByteArray# -> Bool
sameByteArray ByteArray#
ba1# ByteArray#
ba2# = Bool
True
| Int
n1 forall a. Eq a => a -> a -> Bool
/= Int
n2 = Bool
False
| Bool
otherwise = ByteArray -> ByteArray -> Int -> Ordering
compareByteArraysFromBeginning ByteArray
ba1 ByteArray
ba2 Int
n1 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
instance Eq (MutableByteArray s) where
== :: MutableByteArray s -> MutableByteArray s -> Bool
(==) (MutableByteArray MutableByteArray# s
arr#) (MutableByteArray MutableByteArray# s
brr#)
= Int# -> Bool
isTrue# (forall d. MutableByteArray# d -> MutableByteArray# d -> Int#
sameMutableByteArray# MutableByteArray# s
arr# MutableByteArray# s
brr#)
instance Ord ByteArray where
ba1 :: ByteArray
ba1@(ByteArray ByteArray#
ba1#) compare :: ByteArray -> ByteArray -> Ordering
`compare` ba2 :: ByteArray
ba2@(ByteArray ByteArray#
ba2#)
| ByteArray# -> ByteArray# -> Bool
sameByteArray ByteArray#
ba1# ByteArray#
ba2# = Ordering
EQ
| Int
n1 forall a. Eq a => a -> a -> Bool
/= Int
n2 = Int
n1 forall a. Ord a => a -> a -> Ordering
`compare` Int
n2
| Bool
otherwise = ByteArray -> ByteArray -> Int -> Ordering
compareByteArraysFromBeginning ByteArray
ba1 ByteArray
ba2 Int
n1
where
n1 :: Int
n1 = ByteArray -> Int
sizeofByteArray ByteArray
ba1
n2 :: Int
n2 = ByteArray -> Int
sizeofByteArray ByteArray
ba2
appendByteArray :: ByteArray -> ByteArray -> ByteArray
appendByteArray :: ByteArray -> ByteArray -> ByteArray
appendByteArray ByteArray
a ByteArray
b = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
MutableByteArray s
marr <- forall s. Int -> ST s (MutableByteArray s)
newByteArray (ByteArray -> Int
sizeofByteArray ByteArray
a forall a. Num a => a -> a -> a
+ ByteArray -> Int
sizeofByteArray ByteArray
b)
forall s.
MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s ()
copyByteArray MutableByteArray s
marr Int
0 ByteArray
a Int
0 (ByteArray -> Int
sizeofByteArray ByteArray
a)
forall s.
MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s ()
copyByteArray MutableByteArray s
marr (ByteArray -> Int
sizeofByteArray ByteArray
a) ByteArray
b Int
0 (ByteArray -> Int
sizeofByteArray ByteArray
b)
forall s. MutableByteArray s -> ST s ByteArray
unsafeFreezeByteArray MutableByteArray s
marr
concatByteArray :: [ByteArray] -> ByteArray
concatByteArray :: [ByteArray] -> ByteArray
concatByteArray [ByteArray]
arrs = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
let len :: Int
len = [ByteArray] -> Int -> Int
calcLength [ByteArray]
arrs Int
0
MutableByteArray s
marr <- forall s. Int -> ST s (MutableByteArray s)
newByteArray Int
len
forall s. MutableByteArray s -> Int -> [ByteArray] -> ST s ()
pasteByteArrays MutableByteArray s
marr Int
0 [ByteArray]
arrs
forall s. MutableByteArray s -> ST s ByteArray
unsafeFreezeByteArray MutableByteArray s
marr
pasteByteArrays :: MutableByteArray s -> Int -> [ByteArray] -> ST s ()
pasteByteArrays :: forall s. MutableByteArray s -> Int -> [ByteArray] -> ST s ()
pasteByteArrays !MutableByteArray s
_ !Int
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
pasteByteArrays !MutableByteArray s
marr !Int
ix (ByteArray
x : [ByteArray]
xs) = do
forall s.
MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s ()
copyByteArray MutableByteArray s
marr Int
ix ByteArray
x Int
0 (ByteArray -> Int
sizeofByteArray ByteArray
x)
forall s. MutableByteArray s -> Int -> [ByteArray] -> ST s ()
pasteByteArrays MutableByteArray s
marr (Int
ix 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 (ByteArray
x : [ByteArray]
xs) !Int
n = [ByteArray] -> Int -> Int
calcLength [ByteArray]
xs (ByteArray -> Int
sizeofByteArray ByteArray
x forall a. Num a => a -> a -> a
+ Int
n)
emptyByteArray :: ByteArray
emptyByteArray :: ByteArray
emptyByteArray = forall a. (forall s. ST s a) -> a
runST (forall s. Int -> ST s (MutableByteArray s)
newByteArray Int
0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. MutableByteArray s -> ST s ByteArray
unsafeFreezeByteArray)
replicateByteArray :: Int -> ByteArray -> ByteArray
replicateByteArray :: Int -> ByteArray -> ByteArray
replicateByteArray Int
n ByteArray
arr = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
MutableByteArray s
marr <- forall s. Int -> ST s (MutableByteArray s)
newByteArray (Int
n forall a. Num a => a -> a -> a
* ByteArray -> Int
sizeofByteArray ByteArray
arr)
let go :: Int -> ST s ()
go Int
i = if Int
i forall a. Ord a => a -> a -> Bool
< Int
n
then do
forall s.
MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s ()
copyByteArray MutableByteArray s
marr (Int
i forall a. Num a => a -> a -> a
* ByteArray -> Int
sizeofByteArray ByteArray
arr) ByteArray
arr Int
0 (ByteArray -> Int
sizeofByteArray ByteArray
arr)
Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
Int -> ST s ()
go Int
0
forall s. MutableByteArray s -> ST s ByteArray
unsafeFreezeByteArray MutableByteArray s
marr
instance Semigroup ByteArray where
<> :: ByteArray -> ByteArray -> ByteArray
(<>) = ByteArray -> ByteArray -> ByteArray
appendByteArray
sconcat :: NonEmpty ByteArray -> ByteArray
sconcat = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
stimes :: forall b. Integral b => b -> ByteArray -> ByteArray
stimes b
i ByteArray
arr
| Integer
itgr forall a. Ord a => a -> a -> Bool
< Integer
1 = ByteArray
emptyByteArray
| Integer
itgr forall a. Ord a => a -> a -> Bool
<= (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int)) = Int -> ByteArray -> ByteArray
replicateByteArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
itgr) ByteArray
arr
| Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Array.Byte#stimes: cannot allocate the requested amount of memory"
where itgr :: Integer
itgr = forall a. Integral a => a -> Integer
toInteger b
i :: Integer
instance Monoid ByteArray where
mempty :: ByteArray
mempty = ByteArray
emptyByteArray
mappend :: ByteArray -> ByteArray -> ByteArray
mappend = forall a. Semigroup a => a -> a -> a
(<>)
mconcat :: [ByteArray] -> ByteArray
mconcat = [ByteArray] -> ByteArray
concatByteArray
instance IsList ByteArray where
type Item ByteArray = Word8
toList :: ByteArray -> [Item ByteArray]
toList = ByteArray -> [Word8]
byteArrayToList
fromList :: [Item ByteArray] -> ByteArray
fromList [Item ByteArray]
xs = Int -> [Word8] -> ByteArray
byteArrayFromListN (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Item ByteArray]
xs) [Item ByteArray]
xs
fromListN :: Int -> [Item ByteArray] -> ByteArray
fromListN = Int -> [Word8] -> ByteArray
byteArrayFromListN
instance NFData ByteArray where
rnf :: ByteArray -> ()
rnf (ByteArray ByteArray#
_) = ()
instance NFData (MutableByteArray s) where
rnf :: MutableByteArray s -> ()
rnf (MutableByteArray MutableByteArray# s
_) = ()
instance Lift ByteArray where
#if MIN_VERSION_template_haskell(2,17,0)
liftTyped :: forall (m :: * -> *). Quote m => ByteArray -> Code m ByteArray
liftTyped = forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift
#elif MIN_VERSION_template_haskell(2,16,0)
liftTyped = unsafeTExpCoerce . lift
#endif
#if MIN_VERSION_template_haskell(2,16,0)
lift :: forall (m :: * -> *). Quote m => ByteArray -> m Exp
lift (ByteArray ByteArray#
b) = forall (m :: * -> *) a. Monad m => a -> m a
return
(Exp -> Exp -> Exp
AppE (Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'addrToByteArray) (Lit -> Exp
LitE (Integer -> Lit
IntegerL (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))))
(Lit -> Exp
LitE (Bytes -> Lit
BytesPrimL (ForeignPtr Word8 -> Word -> Word -> Bytes
Bytes ForeignPtr Word8
ptr Word
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)))))
where
len# :: Int#
len# = ByteArray# -> Int#
sizeofByteArray# ByteArray#
b
len :: Int
len = Int# -> Int
I# Int#
len#
pb :: ByteArray#
!(ByteArray ByteArray#
pb)
| Int# -> Bool
isTrue# (ByteArray# -> Int#
isByteArrayPinned# ByteArray#
b) = ByteArray# -> ByteArray
ByteArray ByteArray#
b
| Bool
otherwise = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$
\State# s
s -> case forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newPinnedByteArray# Int#
len# State# s
s of
(# State# s
s', MutableByteArray# s
mb #) -> case forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
b Int#
0# MutableByteArray# s
mb Int#
0# Int#
len# State# s
s' of
State# s
s'' -> case forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mb State# s
s'' of
(# State# s
s''', ByteArray#
ret #) -> (# State# s
s''', ByteArray# -> ByteArray
ByteArray ByteArray#
ret #)
ptr :: ForeignPtr Word8
ptr :: ForeignPtr Word8
ptr = forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
pb) (MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# ByteArray#
pb))
#else
lift (ByteArray b) = return
(AppE (AppE (VarE 'addrToByteArray) (LitE (IntegerL (fromIntegral len))))
(LitE (StringPrimL (toList (ByteArray b)))))
where
len# = sizeofByteArray# b
len = I# len#
#endif
addrToByteArray :: Int -> Addr# -> ByteArray
addrToByteArray :: Int -> Addr# -> ByteArray
addrToByteArray (I# Int#
len) Addr#
addr = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$
\State# s
s -> case forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
len State# s
s of
(# State# s
s', MutableByteArray# s
mb #) -> case forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
addr MutableByteArray# s
mb Int#
0# Int#
len State# s
s' of
State# s
s'' -> case forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mb State# s
s'' of
(# State# s
s''', ByteArray#
ret #) -> (# State# s
s''', ByteArray# -> ByteArray
ByteArray ByteArray#
ret #)