{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedFFITypes #-}
module Streamly.Internal.Data.MutByteArray.Type
(
MutByteArray(..)
, getMutByteArray#
, touch
, PinnedState(..)
, isPinned
, pin
, unpin
, empty
, newAs
, new
, new'
, reallocSliceAs
, length
, unsafeAsPtr
, unsafePutSlice
, unsafePutPtrN
, unsafeCloneSliceAs
, unsafeCloneSlice
, unsafePinnedCloneSlice
, unsafeByteCmp
, blockSize
, largeObjectThreshold
, MutableByteArray
, getMutableByteArray#
, newBytesAs
, sizeOfMutableByteArray
, putSliceUnsafe
, cloneSliceUnsafeAs
, cloneSliceUnsafe
, pinnedCloneSliceUnsafe
, pinnedNewAlignedBytes
, asPtrUnsafe
, unsafePinnedAsPtr
, nil
, pinnedNew
) where
#include "deprecation.h"
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad (when)
import Data.Word (Word8)
#ifdef DEBUG
import Debug.Trace (trace)
#endif
import Foreign.C.Types (CSize(..))
import GHC.Base (IO(..))
import System.IO.Unsafe (unsafePerformIO)
import GHC.Exts
import Prelude hiding (length)
data PinnedState
= Pinned
| Unpinned deriving (Int -> PinnedState -> ShowS
[PinnedState] -> ShowS
PinnedState -> String
(Int -> PinnedState -> ShowS)
-> (PinnedState -> String)
-> ([PinnedState] -> ShowS)
-> Show PinnedState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PinnedState -> ShowS
showsPrec :: Int -> PinnedState -> ShowS
$cshow :: PinnedState -> String
show :: PinnedState -> String
$cshowList :: [PinnedState] -> ShowS
showList :: [PinnedState] -> ShowS
Show, PinnedState -> PinnedState -> Bool
(PinnedState -> PinnedState -> Bool)
-> (PinnedState -> PinnedState -> Bool) -> Eq PinnedState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PinnedState -> PinnedState -> Bool
== :: PinnedState -> PinnedState -> Bool
$c/= :: PinnedState -> PinnedState -> Bool
/= :: PinnedState -> PinnedState -> Bool
Eq)
data MutByteArray = MutByteArray (MutableByteArray# RealWorld)
{-# DEPRECATED MutableByteArray "Please use MutByteArray instead" #-}
type MutableByteArray = MutByteArray
{-# INLINE getMutByteArray# #-}
getMutableByteArray#, getMutByteArray# :: MutByteArray -> MutableByteArray# RealWorld
getMutByteArray# :: MutByteArray -> MutableByteArray# RealWorld
getMutByteArray# (MutByteArray MutableByteArray# RealWorld
mbarr) = MutableByteArray# RealWorld
mbarr
{-# INLINE length #-}
sizeOfMutableByteArray, length :: MutByteArray -> IO Int
length :: MutByteArray -> IO Int
length (MutByteArray MutableByteArray# RealWorld
arr) =
(State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int)
-> (State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, Int# #)
forall d. MutableByteArray# d -> State# d -> (# State# d, Int# #)
getSizeofMutableByteArray# MutableByteArray# RealWorld
arr State# RealWorld
s of
(# State# RealWorld
s1, Int#
i #) -> (# State# RealWorld
s1, Int# -> Int
I# Int#
i #)
{-# INLINE touch #-}
touch :: MutByteArray -> IO ()
touch :: MutByteArray -> IO ()
touch (MutByteArray MutableByteArray# RealWorld
contents) =
(State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case MutableByteArray# RealWorld -> State# RealWorld -> State# RealWorld
forall a. a -> State# RealWorld -> State# RealWorld
touch# MutableByteArray# RealWorld
contents State# RealWorld
s of State# RealWorld
s' -> (# State# RealWorld
s', () #)
{-# DEPRECATED unsafePinnedAsPtr "Pin the array and then use unsafeAsPtr." #-}
{-# INLINE unsafePinnedAsPtr #-}
unsafePinnedAsPtr :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b
unsafePinnedAsPtr :: forall (m :: * -> *) a b.
MonadIO m =>
MutByteArray -> (Ptr a -> m b) -> m b
unsafePinnedAsPtr MutByteArray
arr0 Ptr a -> m b
f = do
MutByteArray
arr <- IO MutByteArray -> m MutByteArray
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MutByteArray -> m MutByteArray)
-> IO MutByteArray -> m MutByteArray
forall a b. (a -> b) -> a -> b
$ MutByteArray -> IO MutByteArray
pin MutByteArray
arr0
let !ptr :: Ptr a
ptr = Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents#
(MutableByteArray# RealWorld -> ByteArray#
forall a b. a -> b
unsafeCoerce# (MutByteArray -> MutableByteArray# RealWorld
getMutByteArray# MutByteArray
arr)))
b
r <- Ptr a -> m b
f Ptr a
forall {a}. Ptr a
ptr
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MutByteArray -> IO ()
touch MutByteArray
arr
b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
{-# DEPRECATED asPtrUnsafe "Pin the array and then use unsafeAsPtr." #-}
{-# INLINE asPtrUnsafe #-}
asPtrUnsafe :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b
asPtrUnsafe :: forall (m :: * -> *) a b.
MonadIO m =>
MutByteArray -> (Ptr a -> m b) -> m b
asPtrUnsafe = MutByteArray -> (Ptr a -> m b) -> m b
forall (m :: * -> *) a b.
MonadIO m =>
MutByteArray -> (Ptr a -> m b) -> m b
unsafePinnedAsPtr
{-# INLINE unsafeAsPtr #-}
unsafeAsPtr :: MonadIO m => MutByteArray -> (Ptr a -> IO b) -> m b
unsafeAsPtr :: forall (m :: * -> *) a b.
MonadIO m =>
MutByteArray -> (Ptr a -> IO b) -> m b
unsafeAsPtr MutByteArray
arr Ptr a -> IO b
f = IO b -> m b
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (MutByteArray -> Bool
isPinned MutByteArray
arr))
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error String
"unsafeAsPtr requires the array to be pinned"
let !ptr :: Ptr a
ptr = Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents#
(MutableByteArray# RealWorld -> ByteArray#
forall a b. a -> b
unsafeCoerce# (MutByteArray -> MutableByteArray# RealWorld
getMutByteArray# MutByteArray
arr)))
b
r <- Ptr a -> IO b
f Ptr a
forall {a}. Ptr a
ptr
MutByteArray -> IO ()
touch MutByteArray
arr
b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
{-# NOINLINE empty #-}
empty :: MutByteArray
empty :: MutByteArray
empty = IO MutByteArray -> MutByteArray
forall a. IO a -> a
unsafePerformIO (IO MutByteArray -> MutByteArray)
-> IO MutByteArray -> MutByteArray
forall a b. (a -> b) -> a -> b
$ Int -> IO MutByteArray
new Int
0
{-# DEPRECATED nil "Please use empty instead" #-}
nil :: MutByteArray
nil :: MutByteArray
nil = MutByteArray
empty
blockSize :: Int
blockSize :: Int
blockSize = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024
largeObjectThreshold :: Int
largeObjectThreshold :: Int
largeObjectThreshold = (Int
blockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10
{-# INLINE pinnedNewRaw #-}
pinnedNewRaw :: Int -> IO MutByteArray
pinnedNewRaw :: Int -> IO MutByteArray
pinnedNewRaw (I# Int#
nbytes) = (State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray)
-> (State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newPinnedByteArray# Int#
nbytes State# RealWorld
s of
(# State# RealWorld
s', MutableByteArray# RealWorld
mbarr# #) ->
let c :: MutByteArray
c = MutableByteArray# RealWorld -> MutByteArray
MutByteArray MutableByteArray# RealWorld
mbarr#
in (# State# RealWorld
s', MutByteArray
c #)
{-# INLINE new' #-}
new', pinnedNew :: Int -> IO MutByteArray
new' :: Int -> IO MutByteArray
new' Int
nbytes | Int
nbytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
String -> IO MutByteArray
forall a. String -> a
errorWithoutStackTrace String
"new': size must be >= 0"
new' Int
nbytes = Int -> IO MutByteArray
pinnedNewRaw Int
nbytes
RENAME_PRIME(pinnedNew,new)
{-# INLINE new #-}
new :: Int -> IO MutByteArray
new :: Int -> IO MutByteArray
new Int
nbytes | Int
nbytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
largeObjectThreshold = Int -> IO MutByteArray
pinnedNewRaw Int
nbytes
new Int
nbytes | Int
nbytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
String -> IO MutByteArray
forall a. String -> a
errorWithoutStackTrace String
"newByteArray: size must be >= 0"
new (I# Int#
nbytes) = (State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray)
-> (State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
nbytes State# RealWorld
s of
(# State# RealWorld
s', MutableByteArray# RealWorld
mbarr# #) ->
let c :: MutByteArray
c = MutableByteArray# RealWorld -> MutByteArray
MutByteArray MutableByteArray# RealWorld
mbarr#
in (# State# RealWorld
s', MutByteArray
c #)
{-# DEPRECATED pinnedNewAlignedBytes "Please use pinnedNew instead" #-}
{-# INLINE pinnedNewAlignedBytes #-}
pinnedNewAlignedBytes :: Int -> Int -> IO MutByteArray
pinnedNewAlignedBytes :: Int -> Int -> IO MutByteArray
pinnedNewAlignedBytes Int
nbytes Int
_align | Int
nbytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
String -> IO MutByteArray
forall a. String -> a
errorWithoutStackTrace String
"pinnedNewAlignedBytes: size must be >= 0"
pinnedNewAlignedBytes (I# Int#
nbytes) (I# Int#
align) = (State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray)
-> (State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case Int#
-> Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d.
Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newAlignedPinnedByteArray# Int#
nbytes Int#
align State# RealWorld
s of
(# State# RealWorld
s', MutableByteArray# RealWorld
mbarr# #) ->
let c :: MutByteArray
c = MutableByteArray# RealWorld -> MutByteArray
MutByteArray MutableByteArray# RealWorld
mbarr#
in (# State# RealWorld
s', MutByteArray
c #)
{-# INLINE newAs #-}
newBytesAs, newAs :: PinnedState -> Int -> IO MutByteArray
newAs :: PinnedState -> Int -> IO MutByteArray
newAs PinnedState
Unpinned = Int -> IO MutByteArray
new
newAs PinnedState
Pinned = Int -> IO MutByteArray
pinnedNew
{-# INLINE reallocSliceAs #-}
reallocSliceAs ::
PinnedState -> Int -> MutByteArray -> Int -> Int -> IO MutByteArray
reallocSliceAs :: PinnedState -> Int -> MutByteArray -> Int -> Int -> IO MutByteArray
reallocSliceAs PinnedState
ps Int
newLen (MutByteArray MutableByteArray# RealWorld
src#) Int
srcStart Int
srcLen = do
MutByteArray MutableByteArray# RealWorld
dst# <- PinnedState -> Int -> IO MutByteArray
newBytesAs PinnedState
ps Int
newLen
let !(I# Int#
srcStart#) = Int
srcStart
!(I# Int#
newLen#) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
srcLen Int
newLen
(State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray)
-> (State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# -> (# MutableByteArray# RealWorld
-> Int#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d.
MutableByteArray# d
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableByteArray# MutableByteArray# RealWorld
src# Int#
srcStart#
MutableByteArray# RealWorld
dst# Int#
0# Int#
newLen# State# RealWorld
s#, MutableByteArray# RealWorld -> MutByteArray
MutByteArray MutableByteArray# RealWorld
dst# #)
{-# INLINE unsafePutSlice #-}
putSliceUnsafe, unsafePutSlice ::
MonadIO m
=> MutByteArray
-> Int
-> MutByteArray
-> Int
-> Int
-> m ()
unsafePutSlice :: forall (m :: * -> *).
MonadIO m =>
MutByteArray -> Int -> MutByteArray -> Int -> Int -> m ()
unsafePutSlice MutByteArray
src Int
srcStartBytes MutByteArray
dst Int
dstStartBytes Int
lenBytes = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
#ifdef DEBUG
srcLen <- length src
dstLen <- length dst
when (srcLen - srcStartBytes < lenBytes)
$ error $ "unsafePutSlice: src overflow: start" ++ show srcStartBytes
++ " end " ++ show srcLen ++ " len " ++ show lenBytes
when (dstLen - dstStartBytes < lenBytes)
$ error $ "unsafePutSlice: dst overflow: start" ++ show dstStartBytes
++ " end " ++ show dstLen ++ " len " ++ show lenBytes
#endif
let !(I# Int#
srcStartBytes#) = Int
srcStartBytes
!(I# Int#
dstStartBytes#) = Int
dstStartBytes
!(I# Int#
lenBytes#) = Int
lenBytes
let arrS# :: MutableByteArray# RealWorld
arrS# = MutByteArray -> MutableByteArray# RealWorld
getMutByteArray# MutByteArray
src
arrD# :: MutableByteArray# RealWorld
arrD# = MutByteArray -> MutableByteArray# RealWorld
getMutByteArray# MutByteArray
dst
(State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# -> (# MutableByteArray# RealWorld
-> Int#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d.
MutableByteArray# d
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableByteArray#
MutableByteArray# RealWorld
arrS# Int#
srcStartBytes# MutableByteArray# RealWorld
arrD# Int#
dstStartBytes# Int#
lenBytes# State# RealWorld
s#
, () #)
foreign import ccall unsafe "string.h memcpy" c_memcpy_pinned
:: Addr# -> Addr# -> CSize -> IO (Ptr Word8)
{-# INLINE unsafePutPtrN #-}
unsafePutPtrN ::
MonadIO m
=> Ptr Word8
-> MutByteArray
-> Int
-> Int
-> m ()
unsafePutPtrN :: forall (m :: * -> *).
MonadIO m =>
Ptr Word8 -> MutByteArray -> Int -> Int -> m ()
unsafePutPtrN (Ptr Addr#
srcAddr) MutByteArray
dst Int
dstOffset Int
len = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
#ifdef DEBUG
dstLen <- length dst
when (dstLen - dstOffset < len)
$ error $ "unsafePutPtrN: dst overflow: start" ++ show dstOffset
++ " end " ++ show dstLen ++ " len " ++ show len
#endif
let !dstAddr# :: Addr#
dstAddr# = ByteArray# -> Addr#
byteArrayContents# (MutableByteArray# RealWorld -> ByteArray#
forall a b. a -> b
unsafeCoerce# (MutByteArray -> MutableByteArray# RealWorld
getMutByteArray# MutByteArray
dst))
!(I# Int#
dstOff#) = Int
dstOffset
!dstAddr1# :: Addr#
dstAddr1# = Addr# -> Int# -> Addr#
plusAddr# Addr#
dstAddr# Int#
dstOff#
Ptr Word8
_ <- Addr# -> Addr# -> CSize -> IO (Ptr Word8)
c_memcpy_pinned Addr#
dstAddr1# Addr#
srcAddr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE unsafeCloneSliceAs #-}
cloneSliceUnsafeAs, unsafeCloneSliceAs :: MonadIO m =>
PinnedState -> Int -> Int -> MutByteArray -> m MutByteArray
unsafeCloneSliceAs :: forall (m :: * -> *).
MonadIO m =>
PinnedState -> Int -> Int -> MutByteArray -> m MutByteArray
unsafeCloneSliceAs PinnedState
ps Int
srcOff Int
srcLen MutByteArray
src =
IO MutByteArray -> m MutByteArray
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MutByteArray -> m MutByteArray)
-> IO MutByteArray -> m MutByteArray
forall a b. (a -> b) -> a -> b
$ do
MutByteArray
mba <- PinnedState -> Int -> IO MutByteArray
newAs PinnedState
ps Int
srcLen
MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO ()
forall (m :: * -> *).
MonadIO m =>
MutByteArray -> Int -> MutByteArray -> Int -> Int -> m ()
unsafePutSlice MutByteArray
src Int
srcOff MutByteArray
mba Int
0 Int
srcLen
MutByteArray -> IO MutByteArray
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MutByteArray
mba
{-# INLINE unsafeCloneSlice #-}
cloneSliceUnsafe, unsafeCloneSlice :: MonadIO m => Int -> Int -> MutByteArray -> m MutByteArray
unsafeCloneSlice :: forall (m :: * -> *).
MonadIO m =>
Int -> Int -> MutByteArray -> m MutByteArray
unsafeCloneSlice = PinnedState -> Int -> Int -> MutByteArray -> m MutByteArray
forall (m :: * -> *).
MonadIO m =>
PinnedState -> Int -> Int -> MutByteArray -> m MutByteArray
unsafeCloneSliceAs PinnedState
Unpinned
{-# INLINE unsafePinnedCloneSlice #-}
pinnedCloneSliceUnsafe, unsafePinnedCloneSlice :: MonadIO m =>
Int -> Int -> MutByteArray -> m MutByteArray
unsafePinnedCloneSlice :: forall (m :: * -> *).
MonadIO m =>
Int -> Int -> MutByteArray -> m MutByteArray
unsafePinnedCloneSlice = PinnedState -> Int -> Int -> MutByteArray -> m MutByteArray
forall (m :: * -> *).
MonadIO m =>
PinnedState -> Int -> Int -> MutByteArray -> m MutByteArray
unsafeCloneSliceAs PinnedState
Pinned
unsafeByteCmp
:: MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO Int
unsafeByteCmp :: MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO Int
unsafeByteCmp
(MutByteArray MutableByteArray# RealWorld
marr1) (I# Int#
st1#) (MutByteArray MutableByteArray# RealWorld
marr2) (I# Int#
st2#) (I# Int#
len#) =
(State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int)
-> (State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
let res :: Int
res =
Int# -> Int
I#
(ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#
compareByteArrays#
(MutableByteArray# RealWorld -> ByteArray#
forall a b. a -> b
unsafeCoerce# MutableByteArray# RealWorld
marr1)
Int#
st1#
(MutableByteArray# RealWorld -> ByteArray#
forall a b. a -> b
unsafeCoerce# MutableByteArray# RealWorld
marr2)
Int#
st2#
Int#
len#)
in (# State# RealWorld
s#, Int
res #)
{-# INLINE isPinned #-}
isPinned :: MutByteArray -> Bool
isPinned :: MutByteArray -> Bool
isPinned (MutByteArray MutableByteArray# RealWorld
arr#) =
let pinnedInt :: Int
pinnedInt = Int# -> Int
I# (MutableByteArray# RealWorld -> Int#
forall d. MutableByteArray# d -> Int#
isMutableByteArrayPinned# MutableByteArray# RealWorld
arr#)
in Int
pinnedInt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
{-# INLINE cloneMutableArrayWith# #-}
cloneMutableArrayWith#
:: (Int# -> State# RealWorld -> (# State# RealWorld
, MutableByteArray# RealWorld #))
-> MutableByteArray# RealWorld
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
cloneMutableArrayWith# :: (Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #))
-> MutableByteArray# RealWorld
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
cloneMutableArrayWith# Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
alloc# MutableByteArray# RealWorld
arr# State# RealWorld
s# =
case MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, Int# #)
forall d. MutableByteArray# d -> State# d -> (# State# d, Int# #)
getSizeofMutableByteArray# MutableByteArray# RealWorld
arr# State# RealWorld
s# of
(# State# RealWorld
s1#, Int#
i# #) ->
case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
alloc# Int#
i# State# RealWorld
s1# of
(# State# RealWorld
s2#, MutableByteArray# RealWorld
arr1# #) ->
case MutableByteArray# RealWorld
-> Int#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d.
MutableByteArray# d
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableByteArray# MutableByteArray# RealWorld
arr# Int#
0# MutableByteArray# RealWorld
arr1# Int#
0# Int#
i# State# RealWorld
s2# of
State# RealWorld
s3# -> (# State# RealWorld
s3#, MutableByteArray# RealWorld
arr1# #)
{-# INLINE pin #-}
pin :: MutByteArray -> IO MutByteArray
pin :: MutByteArray -> IO MutByteArray
pin arr :: MutByteArray
arr@(MutByteArray MutableByteArray# RealWorld
marr#) =
if MutByteArray -> Bool
isPinned MutByteArray
arr
then MutByteArray -> IO MutByteArray
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MutByteArray
arr
else
#ifdef DEBUG
do
trace ("pin: Copying array") (return ())
#endif
(State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO
((State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray)
-> (State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
case (Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #))
-> MutableByteArray# RealWorld
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
cloneMutableArrayWith# Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newPinnedByteArray# MutableByteArray# RealWorld
marr# State# RealWorld
s# of
(# State# RealWorld
s1#, MutableByteArray# RealWorld
marr1# #) -> (# State# RealWorld
s1#, MutableByteArray# RealWorld -> MutByteArray
MutByteArray MutableByteArray# RealWorld
marr1# #)
{-# INLINE unpin #-}
unpin :: MutByteArray -> IO MutByteArray
unpin :: MutByteArray -> IO MutByteArray
unpin arr :: MutByteArray
arr@(MutByteArray MutableByteArray# RealWorld
marr#) =
if Bool -> Bool
not (MutByteArray -> Bool
isPinned MutByteArray
arr)
then MutByteArray -> IO MutByteArray
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MutByteArray
arr
else
#ifdef DEBUG
do
trace ("unpin: Copying array") (return ())
#endif
(State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO
((State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray)
-> (State# RealWorld -> (# State# RealWorld, MutByteArray #))
-> IO MutByteArray
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
case (Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #))
-> MutableByteArray# RealWorld
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
cloneMutableArrayWith# Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# MutableByteArray# RealWorld
marr# State# RealWorld
s# of
(# State# RealWorld
s1#, MutableByteArray# RealWorld
marr1# #) -> (# State# RealWorld
s1#, MutableByteArray# RealWorld -> MutByteArray
MutByteArray MutableByteArray# RealWorld
marr1# #)
RENAME(getMutableByteArray#, getMutByteArray#)
RENAME(newBytesAs, newAs)
RENAME(sizeOfMutableByteArray, length)
RENAME(putSliceUnsafe, unsafePutSlice)
RENAME(cloneSliceUnsafeAs, unsafeCloneSliceAs)
RENAME(cloneSliceUnsafe, unsafeCloneSlice)
RENAME(pinnedCloneSliceUnsafe, unsafePinnedCloneSlice)