{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE ScopedTypeVariables #-}
#include "cbor.h"
module Codec.CBOR.Magic
(
grabWord8
, grabWord16
, grabWord32
, grabWord64
, eatTailWord8
, eatTailWord16
, eatTailWord32
, eatTailWord64
, wordToFloat16
, floatToWord16
, wordToFloat32
, wordToFloat64
, word8ToWord
, word16ToWord
, word32ToWord
, word64ToWord
, word8ToInt
, word16ToInt
, word32ToInt
, word64ToInt
, intToWord
, intToInt64
, intToWord64
, int64ToWord64
#if defined(ARCH_32bit)
, word8ToInt64
, word16ToInt64
, word32ToInt64
, word64ToInt64
, word8ToWord64
, word16ToWord64
, word32ToWord64
#endif
, nintegerFromBytes
, uintegerFromBytes
, Counter
, newCounter
, readCounter
, writeCounter
, incCounter
, decCounter
, copyByteStringToByteArray
, copyByteArrayToByteString
) where
import GHC.Exts
import GHC.ST (ST(ST))
import GHC.IO (IO(IO), unsafeDupablePerformIO)
import GHC.Word
import GHC.Int
#if MIN_VERSION_base(4,11,0)
import GHC.Float (castWord32ToFloat, castWord64ToDouble)
#endif
import Foreign.Ptr
#if defined(OPTIMIZE_GMP)
#if defined(HAVE_GHC_BIGNUM)
import qualified GHC.Num.Integer as BigNum
#else
import qualified GHC.Integer.GMP.Internals as Gmp
#endif
#endif
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Unsafe as BS
import Data.Primitive.ByteArray as Prim hiding (copyByteArrayToPtr, copyPtrToMutableByteArray)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.C (CUShort)
import qualified Numeric.Half as Half
#if !defined(HAVE_BYTESWAP_PRIMOPS) || !defined(MEM_UNALIGNED_OPS) || !defined(OPTIMIZE_GMP)
import Data.Bits ((.|.), unsafeShiftL)
#endif
#if defined(ARCH_32bit)
import GHC.IntWord64 (wordToWord64#, word64ToWord#,
intToInt64#, int64ToInt#,
leWord64#, ltWord64#, word64ToInt64#)
#endif
grabWord8 :: Ptr () -> Word8
{-# INLINE grabWord8 #-}
grabWord16 :: Ptr () -> Word16
{-# INLINE grabWord16 #-}
grabWord32 :: Ptr () -> Word32
{-# INLINE grabWord32 #-}
grabWord64 :: Ptr () -> Word64
{-# INLINE grabWord64 #-}
grabWord8 :: Ptr () -> Word8
grabWord8 (Ptr Addr#
ip#) = Word8# -> Word8
W8# (Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
ip# Int#
0#)
#if defined(HAVE_BYTESWAP_PRIMOPS) && \
defined(MEM_UNALIGNED_OPS) && \
!defined(WORDS_BIGENDIAN)
#if MIN_VERSION_ghc_prim(0,8,0)
grabWord16 :: Ptr () -> Word16
grabWord16 (Ptr Addr#
ip#) = Word16# -> Word16
W16# (Word# -> Word16#
wordToWord16# (Word# -> Word#
byteSwap16# (Word16# -> Word#
word16ToWord# (Addr# -> Int# -> Word16#
indexWord16OffAddr# Addr#
ip# Int#
0#))))
grabWord32 :: Ptr () -> Word32
grabWord32 (Ptr Addr#
ip#) = Word32# -> Word32
W32# (Word# -> Word32#
wordToWord32# (Word# -> Word#
byteSwap32# (Word32# -> Word#
word32ToWord# (Addr# -> Int# -> Word32#
indexWord32OffAddr# Addr#
ip# Int#
0#))))
#else
grabWord16 (Ptr ip#) = W16# (narrow16Word# (byteSwap16# (indexWord16OffAddr# ip# 0#)))
grabWord32 (Ptr ip#) = W32# (narrow32Word# (byteSwap32# (indexWord32OffAddr# ip# 0#)))
#endif
#if defined(ARCH_64bit)
#if MIN_VERSION_base(4,17,0)
grabWord64 (Ptr ip#) = W64# (wordToWord64# (byteSwap# (word64ToWord# (indexWord64OffAddr# ip# 0#))))
#else
grabWord64 :: Ptr () -> Word64
grabWord64 (Ptr Addr#
ip#) = Word# -> Word64
W64# (Word# -> Word#
byteSwap# (Addr# -> Int# -> Word#
indexWord64OffAddr# Addr#
ip# Int#
0#))
#endif
#else
grabWord64 (Ptr ip#) = W64# (byteSwap64# (word64ToWord# (indexWord64OffAddr# ip# 0#)))
#endif
#elif defined(MEM_UNALIGNED_OPS) && \
defined(WORDS_BIGENDIAN)
grabWord16 (Ptr ip#) = W16# (indexWord16OffAddr# ip# 0#)
grabWord32 (Ptr ip#) = W32# (indexWord32OffAddr# ip# 0#)
grabWord64 (Ptr ip#) = W64# (indexWord64OffAddr# ip# 0#)
#else
grabWord16 (Ptr ip#) =
case indexWord8OffAddr# ip# 0# of
w0# ->
case indexWord8OffAddr# ip# 1# of
w1# -> w16 w0# `unsafeShiftL` 8 .|.
w16 w1#
where
#if MIN_VERSION_ghc_prim(0,8,0)
w16 w# = W16# (wordToWord16# (word8ToWord# w#))
#else
w16 w# = W16# w#
#endif
grabWord32 (Ptr ip#) =
case indexWord8OffAddr# ip# 0# of
w0# ->
case indexWord8OffAddr# ip# 1# of
w1# ->
case indexWord8OffAddr# ip# 2# of
w2# ->
case indexWord8OffAddr# ip# 3# of
w3# -> w32 w0# `unsafeShiftL` 24 .|.
w32 w1# `unsafeShiftL` 16 .|.
w32 w2# `unsafeShiftL` 8 .|.
w32 w3#
where
#if MIN_VERSION_ghc_prim(0,8,0)
w32 w# = W32# (wordToWord32# (word8ToWord# w#))
#else
w32 w# = W32# w#
#endif
grabWord64 (Ptr ip#) =
case indexWord8OffAddr# ip# 0# of
w0# ->
case indexWord8OffAddr# ip# 1# of
w1# ->
case indexWord8OffAddr# ip# 2# of
w2# ->
case indexWord8OffAddr# ip# 3# of
w3# ->
case indexWord8OffAddr# ip# 4# of
w4# ->
case indexWord8OffAddr# ip# 5# of
w5# ->
case indexWord8OffAddr# ip# 6# of
w6# ->
case indexWord8OffAddr# ip# 7# of
w7# -> w64 w0# `unsafeShiftL` 56 .|.
w64 w1# `unsafeShiftL` 48 .|.
w64 w2# `unsafeShiftL` 40 .|.
w64 w3# `unsafeShiftL` 32 .|.
w64 w4# `unsafeShiftL` 24 .|.
w64 w5# `unsafeShiftL` 16 .|.
w64 w6# `unsafeShiftL` 8 .|.
w64 w7#
where
#if MIN_VERSION_ghc_prim(0,8,0)
toWord :: Word8# -> Word#
toWord w# = word8ToWord# w#
#else
toWord :: Word# -> Word#
toWord w# = w#
#endif
#if WORD_SIZE_IN_BITS == 64
#if MIN_VERSION_base(4,17,0)
w64 w# = W64# (wordToWord64# (toWord w#))
#else
w64 w# = W64# (toWord w#)
#endif
#else
w64 w# = W64# (wordToWord64# (toWord w#))
#endif
#endif
eatTailWord8 :: ByteString -> Word8
eatTailWord8 :: ByteString -> Word8
eatTailWord8 ByteString
xs = forall b a. (Ptr b -> a) -> ByteString -> a
withBsPtr Ptr () -> Word8
grabWord8 (ByteString -> ByteString
BS.unsafeTail ByteString
xs)
{-# INLINE eatTailWord8 #-}
eatTailWord16 :: ByteString -> Word16
eatTailWord16 :: ByteString -> Word16
eatTailWord16 ByteString
xs = forall b a. (Ptr b -> a) -> ByteString -> a
withBsPtr Ptr () -> Word16
grabWord16 (ByteString -> ByteString
BS.unsafeTail ByteString
xs)
{-# INLINE eatTailWord16 #-}
eatTailWord32 :: ByteString -> Word32
eatTailWord32 :: ByteString -> Word32
eatTailWord32 ByteString
xs = forall b a. (Ptr b -> a) -> ByteString -> a
withBsPtr Ptr () -> Word32
grabWord32 (ByteString -> ByteString
BS.unsafeTail ByteString
xs)
{-# INLINE eatTailWord32 #-}
eatTailWord64 :: ByteString -> Word64
eatTailWord64 :: ByteString -> Word64
eatTailWord64 ByteString
xs = forall b a. (Ptr b -> a) -> ByteString -> a
withBsPtr Ptr () -> Word64
grabWord64 (ByteString -> ByteString
BS.unsafeTail ByteString
xs)
{-# INLINE eatTailWord64 #-}
withBsPtr :: (Ptr b -> a) -> ByteString -> a
withBsPtr :: forall b a. (Ptr b -> a) -> ByteString -> a
withBsPtr Ptr b -> a
f (BS.PS ForeignPtr Word8
x Int
off Int
_) =
forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$
\(Ptr Addr#
addr#) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Ptr b -> a
f (forall a. Addr# -> Ptr a
Ptr Addr#
addr# forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off))
{-# INLINE withBsPtr #-}
wordToFloat16 :: Word16 -> Float
wordToFloat16 :: Word16 -> Float
wordToFloat16 = \Word16
x -> Half -> Float
Half.fromHalf (CUShort -> Half
Half.Half (Word16 -> CUShort
cast Word16
x))
where
cast :: Word16 -> CUShort
cast :: Word16 -> CUShort
cast = forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE wordToFloat16 #-}
floatToWord16 :: Float -> Word16
floatToWord16 :: Float -> Word16
floatToWord16 = \Float
x -> CUShort -> Word16
cast (Half -> CUShort
Half.getHalf (Float -> Half
Half.toHalf Float
x))
where
cast :: CUShort -> Word16
cast :: CUShort -> Word16
cast = forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE floatToWord16 #-}
wordToFloat32 :: Word32 -> Float
#if MIN_VERSION_base(4,11,0)
wordToFloat32 :: Word32 -> Float
wordToFloat32 = Word32 -> Float
GHC.Float.castWord32ToFloat
#else
wordToFloat32 (W32# w#) = F# (wordToFloat32# w#)
{-# INLINE wordToFloat32 #-}
wordToFloat32# :: Word# -> Float#
wordToFloat32# w# =
case newByteArray# 4# realWorld# of
(# s', mba# #) ->
case writeWord32Array# mba# 0# w# s' of
s'' ->
case readFloatArray# mba# 0# s'' of
(# _, f# #) -> f#
{-# NOINLINE wordToFloat32# #-}
#endif
wordToFloat64 :: Word64 -> Double
#if MIN_VERSION_base(4,11,0)
wordToFloat64 :: Word64 -> Double
wordToFloat64 = Word64 -> Double
GHC.Float.castWord64ToDouble
#else
wordToFloat64 (W64# w#) = D# (wordToFloat64# w#)
{-# INLINE wordToFloat64 #-}
#if defined(ARCH_64bit)
wordToFloat64# :: Word# -> Double#
#else
wordToFloat64# :: Word64# -> Double#
#endif
wordToFloat64# w# =
case newByteArray# 8# realWorld# of
(# s', mba# #) ->
case writeWord64Array# mba# 0# w# s' of
s'' ->
case readDoubleArray# mba# 0# s'' of
(# _, f# #) -> f#
{-# NOINLINE wordToFloat64# #-}
#endif
word8ToWord :: Word8 -> Word
word16ToWord :: Word16 -> Word
word32ToWord :: Word32 -> Word
#if defined(ARCH_64bit)
word64ToWord :: Word64 -> Word
#else
word64ToWord :: Word64 -> Maybe Word
#endif
word8ToInt :: Word8 -> Int
word16ToInt :: Word16 -> Int
#if defined(ARCH_64bit)
word32ToInt :: Word32 -> Int
#else
word32ToInt :: Word32 -> Maybe Int
#endif
word64ToInt :: Word64 -> Maybe Int
#if defined(ARCH_32bit)
word8ToInt64 :: Word8 -> Int64
word16ToInt64 :: Word16 -> Int64
word32ToInt64 :: Word32 -> Int64
word64ToInt64 :: Word64 -> Maybe Int64
word8ToWord64 :: Word8 -> Word64
word16ToWord64 :: Word16 -> Word64
word32ToWord64 :: Word32 -> Word64
#endif
intToInt64 :: Int -> Int64
intToInt64 :: Int -> Int64
intToInt64 = forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE intToInt64 #-}
intToWord :: Int -> Word
intToWord :: Int -> Word
intToWord = forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE intToWord #-}
intToWord64 :: Int -> Word64
intToWord64 :: Int -> Word64
intToWord64 = forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE intToWord64 #-}
int64ToWord64 :: Int64 -> Word64
int64ToWord64 :: Int64 -> Word64
int64ToWord64 = forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE int64ToWord64 #-}
#if MIN_VERSION_ghc_prim(0,8,0)
word8ToWord :: Word8 -> Word
word8ToWord (W8# Word8#
w#) = Word# -> Word
W# (Word8# -> Word#
word8ToWord# Word8#
w#)
word16ToWord :: Word16 -> Word
word16ToWord (W16# Word16#
w#) = Word# -> Word
W# (Word16# -> Word#
word16ToWord# Word16#
w#)
word32ToWord :: Word32 -> Word
word32ToWord (W32# Word32#
w#) = Word# -> Word
W# (Word32# -> Word#
word32ToWord# Word32#
w#)
#if defined(ARCH_64bit)
#if MIN_VERSION_base(4,17,0)
word64ToWord (W64# w#) = W# (word64ToWord# w#)
#else
word64ToWord :: Word64 -> Word
word64ToWord (W64# Word#
w#) = Word# -> Word
W# Word#
w#
#endif
#else
word64ToWord (W64# w64#) =
case isTrue# (w64# `leWord64#` wordToWord64# 0xffffffff##) of
True -> Just (W# (word64ToWord# w64#))
False -> Nothing
#endif
#else
word8ToWord (W8# w#) = W# w#
word16ToWord (W16# w#) = W# w#
word32ToWord (W32# w#) = W# w#
#if defined(ARCH_64bit)
word64ToWord (W64# w#) = W# w#
#else
word64ToWord (W64# w64#) =
case isTrue# (w64# `leWord64#` wordToWord64# 0xffffffff##) of
True -> Just (W# (word64ToWord# w64#))
False -> Nothing
#endif
#endif
{-# INLINE word8ToWord #-}
{-# INLINE word16ToWord #-}
{-# INLINE word32ToWord #-}
{-# INLINE word64ToWord #-}
#if MIN_VERSION_ghc_prim(0,8,0)
word8ToInt :: Word8 -> Int
word8ToInt (W8# Word8#
w#) = Int# -> Int
I# (Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
w#))
word16ToInt :: Word16 -> Int
word16ToInt (W16# Word16#
w#) = Int# -> Int
I# (Word# -> Int#
word2Int# (Word16# -> Word#
word16ToWord# Word16#
w#))
#if defined(ARCH_64bit)
word32ToInt :: Word32 -> Int
word32ToInt (W32# Word32#
w#) = Int# -> Int
I# (Word# -> Int#
word2Int# (Word32# -> Word#
word32ToWord# Word32#
w#))
#else
word32ToInt (W32# w#) =
case isTrue# (w# `ltWord#` 0x80000000##) of
True -> Just (I# (word2Int# (word32ToWord# w#)))
False -> Nothing
#endif
#else
word8ToInt (W8# w#) = I# (word2Int# w#)
word16ToInt (W16# w#) = I# (word2Int# w#)
#if defined(ARCH_64bit)
word32ToInt (W32# w#) = I# (word2Int# w#)
#else
word32ToInt (W32# w#) =
case isTrue# (w# `ltWord#` 0x80000000##) of
True -> Just (I# (word2Int# w#))
False -> Nothing
#endif
#endif
#if defined(ARCH_64bit)
word64ToInt :: Word64 -> Maybe Int
word64ToInt (W64# Word#
w#) =
#if MIN_VERSION_base(4,17,0)
case isTrue# (word64ToWord# w# `ltWord#` 0x8000000000000000##) of
#else
case Int# -> Bool
isTrue# (Word#
w# Word# -> Word# -> Int#
`ltWord#` Word#
0x8000000000000000##) of
#endif
Bool
True ->
#if MIN_VERSION_base(4,17,0)
Just (I# (word2Int# (word64ToWord# w#)))
#else
forall a. a -> Maybe a
Just (Int# -> Int
I# (Word# -> Int#
word2Int# Word#
w#))
#endif
Bool
False -> forall a. Maybe a
Nothing
#else
word64ToInt (W64# w#) =
case isTrue# (w# `ltWord64#` wordToWord64# 0x80000000##) of
True -> Just (I# (int64ToInt# (word64ToInt64# w#)))
False -> Nothing
#endif
{-# INLINE word8ToInt #-}
{-# INLINE word16ToInt #-}
{-# INLINE word32ToInt #-}
{-# INLINE word64ToInt #-}
#if defined(ARCH_32bit)
word8ToInt64 (W8# w#) = I64# (intToInt64# (word2Int# w#))
word16ToInt64 (W16# w#) = I64# (intToInt64# (word2Int# w#))
word32ToInt64 (W32# w#) = I64# (word64ToInt64# (wordToWord64# w#))
word64ToInt64 (W64# w#) =
case isTrue# (w# `ltWord64#` uncheckedShiftL64# (wordToWord64# 1##) 63#) of
True -> Just (I64# (word64ToInt64# w#))
False -> Nothing
word8ToWord64 (W8# w#) = W64# (wordToWord64# w#)
word16ToWord64 (W16# w#) = W64# (wordToWord64# w#)
word32ToWord64 (W32# w#) = W64# (wordToWord64# w#)
{-# INLINE word8ToInt64 #-}
{-# INLINE word16ToInt64 #-}
{-# INLINE word32ToInt64 #-}
{-# INLINE word64ToInt64 #-}
{-# INLINE word8ToWord64 #-}
{-# INLINE word16ToWord64 #-}
{-# INLINE word32ToWord64 #-}
#endif
nintegerFromBytes :: BS.ByteString -> Integer
nintegerFromBytes :: ByteString -> Integer
nintegerFromBytes ByteString
bs = -Integer
1 forall a. Num a => a -> a -> a
- ByteString -> Integer
uintegerFromBytes ByteString
bs
uintegerFromBytes :: BS.ByteString -> Integer
#if defined(OPTIMIZE_GMP)
uintegerFromBytes :: ByteString -> Integer
uintegerFromBytes (BS.PS ForeignPtr Word8
fp (I# Int#
off#) (I# Int#
len#)) =
forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \(Ptr Addr#
addr#) ->
let addrOff# :: Addr#
addrOff# = Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
off#
in
#if defined(HAVE_GHC_BIGNUM)
Word# -> Addr# -> Int# -> IO Integer
BigNum.integerFromAddr (Int# -> Word#
int2Word# Int#
len#) Addr#
addrOff# Int#
1#
#else
Gmp.importIntegerFromAddr addrOff# (int2Word# len#) 1#
#endif
#else
uintegerFromBytes bs =
case BS.uncons bs of
Nothing -> 0
Just (w0, ws0) -> go (fromIntegral w0) ws0
where
go !acc ws =
case BS.uncons ws of
Nothing -> acc
Just (w, ws') -> go (acc `unsafeShiftL` 8 + fromIntegral w) ws'
#endif
data Counter s = Counter (MutableByteArray# s)
newCounter :: Int -> ST s (Counter s)
newCounter :: forall s. Int -> ST s (Counter s)
newCounter (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#
8# State# s
s of
(# State# s
s', MutableByteArray# s
mba# #) ->
case forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeIntArray# MutableByteArray# s
mba# Int#
0# Int#
n# State# s
s' of
State# s
s'' -> (# State# s
s'', forall s. MutableByteArray# s -> Counter s
Counter MutableByteArray# s
mba# #))
{-# INLINE newCounter #-}
readCounter :: Counter s -> ST s Int
readCounter :: forall s. Counter s -> ST s Int
readCounter (Counter MutableByteArray# s
mba#) =
forall s a. STRep s a -> ST s a
ST (\State# s
s ->
case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readIntArray# MutableByteArray# s
mba# Int#
0# State# s
s of
(# State# s
s', Int#
n# #) -> (# State# s
s', Int# -> Int
I# Int#
n# #))
{-# INLINE readCounter #-}
writeCounter :: Counter s -> Int -> ST s ()
writeCounter :: forall s. Counter s -> Int -> ST s ()
writeCounter (Counter MutableByteArray# s
mba#) (I# Int#
n#) =
forall s a. STRep s a -> ST s a
ST (\State# s
s ->
case forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeIntArray# MutableByteArray# s
mba# Int#
0# Int#
n# State# s
s of
State# s
s' -> (# State# s
s', () #))
{-# INLINE writeCounter #-}
incCounter :: Counter s -> ST s ()
incCounter :: forall s. Counter s -> ST s ()
incCounter Counter s
c = do
Int
x <- forall s. Counter s -> ST s Int
readCounter Counter s
c
forall s. Counter s -> Int -> ST s ()
writeCounter Counter s
c (Int
xforall a. Num a => a -> a -> a
+Int
1)
{-# INLINE incCounter #-}
decCounter :: Counter s -> ST s ()
decCounter :: forall s. Counter s -> ST s ()
decCounter Counter s
c = do
Int
x <- forall s. Counter s -> ST s Int
readCounter Counter s
c
forall s. Counter s -> Int -> ST s ()
writeCounter Counter s
c (Int
xforall a. Num a => a -> a -> a
-Int
1)
{-# INLINE decCounter #-}
copyByteStringToByteArray :: BS.ByteString -> Prim.ByteArray
copyByteStringToByteArray :: ByteString -> ByteArray
copyByteStringToByteArray (BS.PS ForeignPtr Word8
fp Int
off Int
len) =
forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
MutableByteArray RealWorld
mba <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
Prim.newByteArray Int
len
forall a.
Ptr a -> MutableByteArray RealWorld -> Int -> Int -> IO ()
copyPtrToMutableByteArray (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off) MutableByteArray RealWorld
mba Int
0 Int
len
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
Prim.unsafeFreezeByteArray MutableByteArray RealWorld
mba
copyByteArrayToByteString :: Prim.ByteArray
-> Int
-> Int
-> BS.ByteString
copyByteArrayToByteString :: ByteArray -> Int -> Int -> ByteString
copyByteArrayToByteString ByteArray
ba Int
off Int
len =
forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
BS.mallocByteString Int
len
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
forall a. ByteArray -> Int -> Ptr a -> Int -> IO ()
copyByteArrayToPtr ByteArray
ba Int
off Ptr Word8
ptr Int
len
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
BS.PS ForeignPtr Word8
fp Int
0 Int
len)
copyPtrToMutableByteArray :: Ptr a
-> MutableByteArray RealWorld
-> Int
-> Int
-> IO ()
copyPtrToMutableByteArray :: forall a.
Ptr a -> MutableByteArray RealWorld -> Int -> Int -> IO ()
copyPtrToMutableByteArray (Ptr Addr#
addr#) (MutableByteArray MutableByteArray# RealWorld
mba#) (I# Int#
off#) (I# Int#
len#) =
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s ->
case forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
addr# MutableByteArray# RealWorld
mba# Int#
off# Int#
len# State# RealWorld
s of
State# RealWorld
s' -> (# State# RealWorld
s', () #))
copyByteArrayToPtr :: ByteArray
-> Int
-> Ptr a
-> Int
-> IO ()
copyByteArrayToPtr :: forall a. ByteArray -> Int -> Ptr a -> Int -> IO ()
copyByteArrayToPtr (ByteArray ByteArray#
ba#) (I# Int#
off#) (Ptr Addr#
addr#) (I# Int#
len#) =
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s ->
case forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
copyByteArrayToAddr# ByteArray#
ba# Int#
off# Addr#
addr# Int#
len# State# RealWorld
s of
State# RealWorld
s' -> (# State# RealWorld
s', () #))