{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples       #-}
module Basement.Block.Base
    ( Block(..)
    , MutableBlock(..)
    -- * Basic accessor
    , unsafeNew
    , unsafeThaw
    , unsafeFreeze
    , unsafeShrink
    , unsafeCopyElements
    , unsafeCopyElementsRO
    , unsafeCopyBytes
    , unsafeCopyBytesRO
    , unsafeCopyBytesPtr
    , unsafeRead
    , unsafeWrite
    , unsafeIndex
    -- * Properties
    , length
    , lengthBytes
    , isPinned
    , isMutablePinned
    , mutableLength
    , mutableLengthBytes
    -- * Other methods
    , empty
    , mutableEmpty
    , new
    , newPinned
    , withPtr
    , withMutablePtr
    , withMutablePtrHint
    , mutableWithPtr
    , unsafeRecast
    ) where

import           GHC.Prim
import           GHC.Types
import           GHC.ST
import           GHC.IO
import qualified Data.List
import           Basement.Compat.Base
import           Data.Proxy
import           Basement.Compat.Primitive
import           Basement.Compat.Semigroup
import           Basement.Bindings.Memory (sysHsMemcmpBaBa)
import           Basement.Types.OffsetSize
import           Basement.Monad
import           Basement.NormalForm
import           Basement.Numerical.Additive
import           Basement.PrimType

-- | A block of memory containing unpacked bytes representing values of type 'ty'
data Block ty = Block ByteArray#
    deriving (Typeable)

unsafeBlockPtr :: Block ty -> Ptr ty
unsafeBlockPtr :: forall ty. Block ty -> Ptr ty
unsafeBlockPtr (Block ByteArray#
arrBa) = forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
arrBa)
{-# INLINE unsafeBlockPtr #-}

instance Data ty => Data (Block ty) where
    dataTypeOf :: Block ty -> DataType
dataTypeOf Block ty
_ = DataType
blockType
    toConstr :: Block ty -> Constr
toConstr Block ty
_   = 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 (Block ty)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_  = forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"

blockType :: DataType
blockType :: DataType
blockType = [Char] -> DataType
mkNoRepType [Char]
"Basement.Block"

instance NormalForm (Block ty) where
    toNormalForm :: Block ty -> ()
toNormalForm (Block !ByteArray#
_) = ()
instance (PrimType ty, Show ty) => Show (Block ty) where
    show :: Block ty -> [Char]
show Block ty
v = forall a. Show a => a -> [Char]
show (forall l. IsList l => l -> [Item l]
toList Block ty
v)
instance (PrimType ty, Eq ty) => Eq (Block ty) where
    {-# SPECIALIZE instance Eq (Block Word8) #-}
    == :: Block ty -> Block ty -> Bool
(==) = forall ty. (PrimType ty, Eq ty) => Block ty -> Block ty -> Bool
equal
instance (PrimType ty, Ord ty) => Ord (Block ty) where
    compare :: Block ty -> Block ty -> Ordering
compare = forall ty.
(Ord ty, PrimType ty) =>
Block ty -> Block ty -> Ordering
internalCompare

instance PrimType ty => Semigroup (Block ty) where
    <> :: Block ty -> Block ty -> Block ty
(<>) = forall ty. Block ty -> Block ty -> Block ty
append
instance PrimType ty => Monoid (Block ty) where
    mempty :: Block ty
mempty  = forall ty. Block ty
empty
    mconcat :: [Block ty] -> Block ty
mconcat = forall ty. [Block ty] -> Block ty
concat

instance PrimType ty => IsList (Block ty) where
    type Item (Block ty) = ty
    fromList :: [Item (Block ty)] -> Block ty
fromList = forall ty. PrimType ty => [ty] -> Block ty
internalFromList
    toList :: Block ty -> [Item (Block ty)]
toList = forall ty. PrimType ty => Block ty -> [ty]
internalToList

-- | A Mutable block of memory containing unpacked bytes representing values of type 'ty'
data MutableBlock ty st = MutableBlock (MutableByteArray# st)

isPinned :: Block ty -> PinnedStatus
isPinned :: forall ty. Block ty -> PinnedStatus
isPinned (Block ByteArray#
ba) = Pinned# -> PinnedStatus
toPinnedStatus# (ByteArray# -> Pinned#
compatIsByteArrayPinned# ByteArray#
ba)

isMutablePinned :: MutableBlock s ty -> PinnedStatus
isMutablePinned :: forall s ty. MutableBlock s ty -> PinnedStatus
isMutablePinned (MutableBlock MutableByteArray# ty
mba) = Pinned# -> PinnedStatus
toPinnedStatus# (forall s. MutableByteArray# s -> Pinned#
compatIsMutableByteArrayPinned# MutableByteArray# ty
mba)

length :: forall ty . PrimType ty => Block ty -> CountOf ty
length :: forall ty. PrimType ty => Block ty -> CountOf ty
length (Block ByteArray#
ba) =
    case forall ty. PrimType ty => Proxy ty -> Int
primShiftToBytes (forall {k} (t :: k). Proxy t
Proxy :: Proxy ty) of
        Int
0           -> forall ty. Int -> CountOf ty
CountOf (Pinned# -> Int
I# (ByteArray# -> Pinned#
sizeofByteArray# ByteArray#
ba))
        (I# Pinned#
szBits) -> forall ty. Int -> CountOf ty
CountOf (Pinned# -> Int
I# (Pinned# -> Pinned# -> Pinned#
uncheckedIShiftRL# (ByteArray# -> Pinned#
sizeofByteArray# ByteArray#
ba) Pinned#
szBits))
{-# INLINE[1] length #-}
{-# SPECIALIZE [2] length :: Block Word8 -> CountOf Word8 #-}

lengthBytes :: Block ty -> CountOf Word8
lengthBytes :: forall ty. Block ty -> CountOf Word8
lengthBytes (Block ByteArray#
ba) = forall ty. Int -> CountOf ty
CountOf (Pinned# -> Int
I# (ByteArray# -> Pinned#
sizeofByteArray# ByteArray#
ba))
{-# INLINE[1] lengthBytes #-}

-- | Return the length of a Mutable Block
--
-- note: we don't allow resizing yet, so this can remain a pure function
mutableLength :: forall ty st . PrimType ty => MutableBlock ty st -> CountOf ty
mutableLength :: forall ty st. PrimType ty => MutableBlock ty st -> CountOf ty
mutableLength MutableBlock ty st
mb = forall a b. (PrimType a, PrimType b) => CountOf a -> CountOf b
sizeRecast forall a b. (a -> b) -> a -> b
$ forall ty st. MutableBlock ty st -> CountOf Word8
mutableLengthBytes MutableBlock ty st
mb
{-# INLINE[1] mutableLength #-}

mutableLengthBytes :: MutableBlock ty st -> CountOf Word8
mutableLengthBytes :: forall ty st. MutableBlock ty st -> CountOf Word8
mutableLengthBytes (MutableBlock MutableByteArray# st
mba) = forall ty. Int -> CountOf ty
CountOf (Pinned# -> Int
I# (forall s. MutableByteArray# s -> Pinned#
sizeofMutableByteArray# MutableByteArray# st
mba))
{-# INLINE[1] mutableLengthBytes #-}

-- | Create an empty block of memory
empty :: Block ty
empty :: forall ty. Block ty
empty = forall ty. ByteArray# -> Block ty
Block ByteArray#
ba where !(Block ByteArray#
ba) = Block ()
empty_

empty_ :: Block ()
empty_ :: Block ()
empty_ = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState (ST s))
s1 ->
    case forall d.
Pinned# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Pinned#
0# State# (PrimState (ST s))
s1           of { (# State# s
s2, MutableByteArray# s
mba #) ->
    case forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba State# s
s2 of { (# State# s
s3, ByteArray#
ba  #) ->
        (# State# s
s3, forall ty. ByteArray# -> Block ty
Block ByteArray#
ba #) }}

mutableEmpty :: PrimMonad prim => prim (MutableBlock ty (PrimState prim))
mutableEmpty :: forall (prim :: * -> *) ty.
PrimMonad prim =>
prim (MutableBlock ty (PrimState prim))
mutableEmpty = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
s1 ->
    case forall d.
Pinned# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Pinned#
0# State# (PrimState prim)
s1 of { (# State# (PrimState prim)
s2, MutableByteArray# (PrimState prim)
mba #) ->
        (# State# (PrimState prim)
s2, forall ty st. MutableByteArray# st -> MutableBlock ty st
MutableBlock MutableByteArray# (PrimState prim)
mba #) }

-- | Return the element at a specific index from an array without bounds checking.
--
-- Reading from invalid memory can return unpredictable and invalid values.
-- use 'index' if unsure.
unsafeIndex :: forall ty . PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex :: forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex (Block ByteArray#
ba) Offset ty
n = forall ty. PrimType ty => ByteArray# -> Offset ty -> ty
primBaIndex ByteArray#
ba Offset ty
n
{-# SPECIALIZE unsafeIndex :: Block Word8 -> Offset Word8 -> Word8 #-}
{-# INLINE unsafeIndex #-}

-- | make a block from a list of elements.
internalFromList :: PrimType ty => [ty] -> Block ty
internalFromList :: forall ty. PrimType ty => [ty] -> Block ty
internalFromList [ty]
l = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    MutableBlock ty s
ma <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new (forall ty. Int -> CountOf ty
CountOf Int
len)
    forall {m :: * -> *} {t} {t} {a}.
(Monad m, Additive t, Integral t) =>
t -> [t] -> (t -> t -> m a) -> m ()
iter forall a. Additive a => a
azero [ty]
l forall a b. (a -> b) -> a -> b
$ \Offset ty
i ty
x -> forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MutableBlock ty s
ma Offset ty
i ty
x
    forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty s
ma
  where
    !len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length [ty]
l

    iter :: t -> [t] -> (t -> t -> m a) -> m ()
iter t
_  []     t -> t -> m a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    iter !t
i (t
x:[t]
xs) t -> t -> m a
z = t -> t -> m a
z t
i t
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t -> [t] -> (t -> t -> m a) -> m ()
iter (t
iforall a. Additive a => a -> a -> a
+t
1) [t]
xs t -> t -> m a
z

-- | transform a block to a list.
internalToList :: forall ty . PrimType ty => Block ty -> [ty]
internalToList :: forall ty. PrimType ty => Block ty -> [ty]
internalToList blk :: Block ty
blk@(Block ByteArray#
ba)
    | CountOf ty
len forall a. Eq a => a -> a -> Bool
== forall a. Additive a => a
azero = []
    | Bool
otherwise    = Offset ty -> [ty]
loop forall a. Additive a => a
azero
  where
    !len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk
    loop :: Offset ty -> [ty]
loop !Offset ty
i | Offset ty
i forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = []
            | Bool
otherwise  = forall ty. PrimType ty => ByteArray# -> Offset ty -> ty
primBaIndex ByteArray#
ba Offset ty
i forall a. a -> [a] -> [a]
: Offset ty -> [ty]
loop (Offset ty
iforall a. Additive a => a -> a -> a
+Offset ty
1)

-- | Check if two blocks are identical
equal :: (PrimType ty, Eq ty) => Block ty -> Block ty -> Bool
equal :: forall ty. (PrimType ty, Eq ty) => Block ty -> Block ty -> Bool
equal Block ty
a Block ty
b
    | CountOf Word8
la forall a. Eq a => a -> a -> Bool
/= CountOf Word8
lb  = Bool
False
    | Bool
otherwise = Offset ty -> Bool
loop forall a. Additive a => a
azero
  where
    !la :: CountOf Word8
la = forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
a
    !lb :: CountOf Word8
lb = forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
b
    lat :: CountOf ty
lat = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
a

    loop :: Offset ty -> Bool
loop !Offset ty
n | Offset ty
n forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
lat = Bool
True
            | Bool
otherwise  = (forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
a Offset ty
n forall a. Eq a => a -> a -> Bool
== forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
b Offset ty
n) Bool -> Bool -> Bool
&& Offset ty -> Bool
loop (Offset ty
nforall a. Additive a => a -> a -> a
+forall {ty}. Offset ty
o1)
    o1 :: Offset ty
o1 = forall ty. Int -> Offset ty
Offset (Pinned# -> Int
I# Pinned#
1#)
{-# RULES "Block/Eq/Word8" [3]
   forall (a :: Block Word8) b . equal a b = equalMemcmp a b #-}
{-# INLINEABLE [2] equal #-}
-- {-# SPECIALIZE equal :: Block Word8 -> Block Word8 -> Bool #-}

equalMemcmp :: PrimMemoryComparable ty => Block ty -> Block ty -> Bool
equalMemcmp :: forall ty. PrimMemoryComparable ty => Block ty -> Block ty -> Bool
equalMemcmp b1 :: Block ty
b1@(Block ByteArray#
a) b2 :: Block ty
b2@(Block ByteArray#
b)
    | CountOf Word8
la forall a. Eq a => a -> a -> Bool
/= CountOf Word8
lb  = Bool
False
    | Bool
otherwise = forall a. IO a -> a
unsafeDupablePerformIO (ByteArray#
-> Offset Word8
-> ByteArray#
-> Offset Word8
-> CountOf Word8
-> IO CInt
sysHsMemcmpBaBa ByteArray#
a Offset Word8
0 ByteArray#
b Offset Word8
0 CountOf Word8
la) forall a. Eq a => a -> a -> Bool
== CInt
0
  where
    la :: CountOf Word8
la = forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
b1
    lb :: CountOf Word8
lb = forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
b2
{-# SPECIALIZE equalMemcmp :: Block Word8 -> Block Word8 -> Bool #-}

-- | Compare 2 blocks
internalCompare :: (Ord ty, PrimType ty) => Block ty -> Block ty -> Ordering
internalCompare :: forall ty.
(Ord ty, PrimType ty) =>
Block ty -> Block ty -> Ordering
internalCompare Block ty
a Block ty
b = Offset ty -> Ordering
loop forall a. Additive a => a
azero
  where
    !la :: CountOf ty
la = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
a
    !lb :: CountOf ty
lb = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
b
    !end :: Offset ty
end = forall a. CountOf a -> Offset a
sizeAsOffset (forall a. Ord a => a -> a -> a
min CountOf ty
la CountOf ty
lb)
    loop :: Offset ty -> Ordering
loop !Offset ty
n
        | Offset ty
n forall a. Eq a => a -> a -> Bool
== Offset ty
end  = CountOf ty
la forall a. Ord a => a -> a -> Ordering
`compare` CountOf ty
lb
        | ty
v1 forall a. Eq a => a -> a -> Bool
== ty
v2  = Offset ty -> Ordering
loop (Offset ty
n forall a. Additive a => a -> a -> a
+ forall ty. Int -> Offset ty
Offset (Pinned# -> Int
I# Pinned#
1#))
        | Bool
otherwise = ty
v1 forall a. Ord a => a -> a -> Ordering
`compare` ty
v2
      where
        v1 :: ty
v1 = forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
a Offset ty
n
        v2 :: ty
v2 = forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
b Offset ty
n
{-# RULES "Block/Ord/Word8" [3] forall (a :: Block Word8) b . internalCompare a b = compareMemcmp a b #-}
{-# NOINLINE internalCompare #-}

compareMemcmp :: PrimMemoryComparable ty => Block ty -> Block ty -> Ordering
compareMemcmp :: forall ty.
PrimMemoryComparable ty =>
Block ty -> Block ty -> Ordering
compareMemcmp b1 :: Block ty
b1@(Block ByteArray#
a) b2 :: Block ty
b2@(Block ByteArray#
b) =
    case forall a. IO a -> a
unsafeDupablePerformIO (ByteArray#
-> Offset Word8
-> ByteArray#
-> Offset Word8
-> CountOf Word8
-> IO CInt
sysHsMemcmpBaBa ByteArray#
a Offset Word8
0 ByteArray#
b Offset Word8
0 CountOf Word8
sz) of
        CInt
0             -> CountOf Word8
la forall a. Ord a => a -> a -> Ordering
`compare` CountOf Word8
lb
        CInt
n | CInt
n forall a. Ord a => a -> a -> Bool
> CInt
0     -> Ordering
GT
          | Bool
otherwise -> Ordering
LT
  where
    la :: CountOf Word8
la = forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
b1
    lb :: CountOf Word8
lb = forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
b2
    sz :: CountOf Word8
sz = forall a. Ord a => a -> a -> a
min CountOf Word8
la CountOf Word8
lb
{-# SPECIALIZE [3] compareMemcmp :: Block Word8 -> Block Word8 -> Ordering #-}

-- | Append 2 blocks together by creating a new bigger block
append :: Block ty -> Block ty -> Block ty
append :: forall ty. Block ty -> Block ty -> Block ty
append Block ty
a Block ty
b
    | CountOf Word8
la forall a. Eq a => a -> a -> Bool
== forall a. Additive a => a
azero = Block ty
b
    | CountOf Word8
lb forall a. Eq a => a -> a -> Bool
== forall a. Additive a => a
azero = Block ty
a
    | Bool
otherwise = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
        MutableBlock ty s
r  <- forall (prim :: * -> *) ty.
PrimMonad prim =>
PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
unsafeNew PinnedStatus
Unpinned (CountOf Word8
laforall a. Additive a => a -> a -> a
+CountOf Word8
lb)
        forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytesRO MutableBlock ty s
r Offset Word8
0                 Block ty
a Offset Word8
0 CountOf Word8
la
        forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytesRO MutableBlock ty s
r (forall a. CountOf a -> Offset a
sizeAsOffset CountOf Word8
la) Block ty
b Offset Word8
0 CountOf Word8
lb
        forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty s
r
  where
    !la :: CountOf Word8
la = forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
a
    !lb :: CountOf Word8
lb = forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
b

concat :: forall ty . [Block ty] -> Block ty
concat :: forall ty. [Block ty] -> Block ty
concat [Block ty]
original = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    MutableBlock ty s
r <- forall (prim :: * -> *) ty.
PrimMonad prim =>
PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
unsafeNew PinnedStatus
Unpinned CountOf Word8
total
    forall {f :: * -> *} {ty}.
PrimMonad f =>
MutableBlock ty (PrimState f) -> Offset Word8 -> [Block ty] -> f ()
goCopy MutableBlock ty s
r forall {ty}. Offset ty
zero [Block ty]
original
    forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty s
r
  where
    !total :: CountOf Word8
total = forall {ty}. CountOf Word8 -> [Block ty] -> CountOf Word8
size CountOf Word8
0 [Block ty]
original
    -- size
    size :: CountOf Word8 -> [Block ty] -> CountOf Word8
size !CountOf Word8
sz []     = CountOf Word8
sz
    size !CountOf Word8
sz (Block ty
x:[Block ty]
xs) = CountOf Word8 -> [Block ty] -> CountOf Word8
size (forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
x forall a. Additive a => a -> a -> a
+ CountOf Word8
sz) [Block ty]
xs

    zero :: Offset ty
zero = forall ty. Int -> Offset ty
Offset Int
0

    goCopy :: MutableBlock ty (PrimState f) -> Offset Word8 -> [Block ty] -> f ()
goCopy MutableBlock ty (PrimState f)
r = Offset Word8 -> [Block ty] -> f ()
loop
      where
        loop :: Offset Word8 -> [Block ty] -> f ()
loop Offset Word8
_  []      = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        loop !Offset Word8
i (Block ty
x:[Block ty]
xs) = do
            forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytesRO MutableBlock ty (PrimState f)
r Offset Word8
i Block ty
x forall {ty}. Offset ty
zero CountOf Word8
lx
            Offset Word8 -> [Block ty] -> f ()
loop (Offset Word8
i forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf Word8
lx) [Block ty]
xs
          where !lx :: CountOf Word8
lx = forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
x

-- | Freeze a mutable block into a block.
--
-- If the mutable block is still use after freeze,
-- then the modification will be reflected in an unexpected
-- way in the Block.
unsafeFreeze :: PrimMonad prim => MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze :: forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze (MutableBlock MutableByteArray# (PrimState prim)
mba) = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
s1 ->
    case forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# (PrimState prim)
mba State# (PrimState prim)
s1 of
        (# State# (PrimState prim)
s2, ByteArray#
ba #) -> (# State# (PrimState prim)
s2, forall ty. ByteArray# -> Block ty
Block ByteArray#
ba #)
{-# INLINE unsafeFreeze #-}

unsafeShrink :: PrimMonad prim => MutableBlock ty (PrimState prim) -> CountOf ty -> prim (MutableBlock ty (PrimState prim))
unsafeShrink :: forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> CountOf ty -> prim (MutableBlock ty (PrimState prim))
unsafeShrink (MutableBlock MutableByteArray# (PrimState prim)
mba) (CountOf (I# Pinned#
nsz)) = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
s ->
    case forall d. MutableByteArray# d -> Pinned# -> State# d -> State# d
shrinkMutableByteArray# MutableByteArray# (PrimState prim)
mba Pinned#
nsz State# (PrimState prim)
s of
        State# (PrimState prim)
s -> (# State# (PrimState prim)
s, forall ty st. MutableByteArray# st -> MutableBlock ty st
MutableBlock MutableByteArray# (PrimState prim)
mba #)

-- | Thaw an immutable block.
--
-- If the immutable block is modified, then the original immutable block will
-- be modified too, but lead to unexpected results when querying
unsafeThaw :: (PrimType ty, PrimMonad prim) => Block ty -> prim (MutableBlock ty (PrimState prim))
unsafeThaw :: forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
Block ty -> prim (MutableBlock ty (PrimState prim))
unsafeThaw (Block ByteArray#
ba) = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
st -> (# State# (PrimState prim)
st, forall ty st. MutableByteArray# st -> MutableBlock ty st
MutableBlock (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# ByteArray#
ba) #)

-- | Create a new mutable block of a specific size in bytes.
--
-- Note that no checks are made to see if the size in bytes is compatible with the size
-- of the underlaying element 'ty' in the block.
--
-- use 'new' if unsure
unsafeNew :: PrimMonad prim
          => PinnedStatus
          -> CountOf Word8
          -> prim (MutableBlock ty (PrimState prim))
unsafeNew :: forall (prim :: * -> *) ty.
PrimMonad prim =>
PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
unsafeNew PinnedStatus
pinSt (CountOf (I# Pinned#
bytes)) = case PinnedStatus
pinSt of
    PinnedStatus
Unpinned -> forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
s1 -> case forall d.
Pinned# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Pinned#
bytes State# (PrimState prim)
s1 of { (# State# (PrimState prim)
s2, MutableByteArray# (PrimState prim)
mba #) -> (# State# (PrimState prim)
s2, forall ty st. MutableByteArray# st -> MutableBlock ty st
MutableBlock MutableByteArray# (PrimState prim)
mba #) }
    PinnedStatus
_        -> forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
s1 -> case forall d.
Pinned#
-> Pinned# -> State# d -> (# State# d, MutableByteArray# d #)
newAlignedPinnedByteArray# Pinned#
bytes Pinned#
8# State# (PrimState prim)
s1 of { (# State# (PrimState prim)
s2, MutableByteArray# (PrimState prim)
mba #) -> (# State# (PrimState prim)
s2, forall ty st. MutableByteArray# st -> MutableBlock ty st
MutableBlock MutableByteArray# (PrimState prim)
mba #) }

-- | Create a new unpinned mutable block of a specific N size of 'ty' elements
--
-- If the size exceeds a GHC-defined threshold, then the memory will be
-- pinned. To be certain about pinning status with small size, use 'newPinned'
new :: forall prim ty . (PrimMonad prim, PrimType ty) => CountOf ty -> prim (MutableBlock ty (PrimState prim))
new :: forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new CountOf ty
n = forall (prim :: * -> *) ty.
PrimMonad prim =>
PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
unsafeNew PinnedStatus
Unpinned (forall ty. CountOf Word8 -> CountOf ty -> CountOf Word8
sizeOfE (forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes (forall {k} (t :: k). Proxy t
Proxy :: Proxy ty)) CountOf ty
n)

-- | Create a new pinned mutable block of a specific N size of 'ty' elements
newPinned :: forall prim ty . (PrimMonad prim, PrimType ty) => CountOf ty -> prim (MutableBlock ty (PrimState prim))
newPinned :: forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
newPinned CountOf ty
n = forall (prim :: * -> *) ty.
PrimMonad prim =>
PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
unsafeNew PinnedStatus
Pinned (forall ty. CountOf Word8 -> CountOf ty -> CountOf Word8
sizeOfE (forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes (forall {k} (t :: k). Proxy t
Proxy :: Proxy ty)) CountOf ty
n)

-- | Copy a number of elements from an array to another array with offsets
unsafeCopyElements :: forall prim ty . (PrimMonad prim, PrimType ty)
                   => MutableBlock ty (PrimState prim) -- ^ destination mutable block
                   -> Offset ty                        -- ^ offset at destination
                   -> MutableBlock ty (PrimState prim) -- ^ source mutable block
                   -> Offset ty                        -- ^ offset at source
                   -> CountOf ty                          -- ^ number of elements to copy
                   -> prim ()
unsafeCopyElements :: forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim)
-> Offset ty
-> MutableBlock ty (PrimState prim)
-> Offset ty
-> CountOf ty
-> prim ()
unsafeCopyElements MutableBlock ty (PrimState prim)
dstMb Offset ty
destOffset MutableBlock ty (PrimState prim)
srcMb Offset ty
srcOffset CountOf ty
n = -- (MutableBlock dstMba) ed (MutableBlock srcBa) es n =
    forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> MutableBlock ty (PrimState prim)
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytes MutableBlock ty (PrimState prim)
dstMb (forall ty. CountOf Word8 -> Offset ty -> Offset Word8
offsetOfE CountOf Word8
sz Offset ty
destOffset)
                    MutableBlock ty (PrimState prim)
srcMb (forall ty. CountOf Word8 -> Offset ty -> Offset Word8
offsetOfE CountOf Word8
sz Offset ty
srcOffset)
                    (forall ty. CountOf Word8 -> CountOf ty -> CountOf Word8
sizeOfE CountOf Word8
sz CountOf ty
n)
  where
    !sz :: CountOf Word8
sz = forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes (forall {k} (t :: k). Proxy t
Proxy :: Proxy ty)

unsafeCopyElementsRO :: forall prim ty . (PrimMonad prim, PrimType ty)
                     => MutableBlock ty (PrimState prim) -- ^ destination mutable block
                     -> Offset ty                        -- ^ offset at destination
                     -> Block ty                         -- ^ source block
                     -> Offset ty                        -- ^ offset at source
                     -> CountOf ty                          -- ^ number of elements to copy
                     -> prim ()
unsafeCopyElementsRO :: forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim)
-> Offset ty -> Block ty -> Offset ty -> CountOf ty -> prim ()
unsafeCopyElementsRO MutableBlock ty (PrimState prim)
dstMb Offset ty
destOffset Block ty
srcMb Offset ty
srcOffset CountOf ty
n =
    forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytesRO MutableBlock ty (PrimState prim)
dstMb (forall ty. CountOf Word8 -> Offset ty -> Offset Word8
offsetOfE CountOf Word8
sz Offset ty
destOffset)
                      Block ty
srcMb (forall ty. CountOf Word8 -> Offset ty -> Offset Word8
offsetOfE CountOf Word8
sz Offset ty
srcOffset)
                      (forall ty. CountOf Word8 -> CountOf ty -> CountOf Word8
sizeOfE CountOf Word8
sz CountOf ty
n)
  where
    !sz :: CountOf Word8
sz = forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes (forall {k} (t :: k). Proxy t
Proxy :: Proxy ty)

-- | Copy a number of bytes from a MutableBlock to another MutableBlock with specific byte offsets
unsafeCopyBytes :: forall prim ty . PrimMonad prim
                => MutableBlock ty (PrimState prim) -- ^ destination mutable block
                -> Offset Word8                     -- ^ offset at destination
                -> MutableBlock ty (PrimState prim) -- ^ source mutable block
                -> Offset Word8                     -- ^ offset at source
                -> CountOf Word8                       -- ^ number of elements to copy
                -> prim ()
unsafeCopyBytes :: forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> MutableBlock ty (PrimState prim)
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytes (MutableBlock MutableByteArray# (PrimState prim)
dstMba) (Offset (I# Pinned#
d)) (MutableBlock MutableByteArray# (PrimState prim)
srcBa) (Offset (I# Pinned#
s)) (CountOf (I# Pinned#
n)) =
    forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
st -> (# forall d.
MutableByteArray# d
-> Pinned#
-> MutableByteArray# d
-> Pinned#
-> Pinned#
-> State# d
-> State# d
copyMutableByteArray# MutableByteArray# (PrimState prim)
srcBa Pinned#
s MutableByteArray# (PrimState prim)
dstMba Pinned#
d Pinned#
n State# (PrimState prim)
st, () #)
{-# INLINE unsafeCopyBytes #-}

-- | Copy a number of bytes from a Block to a MutableBlock with specific byte offsets
unsafeCopyBytesRO :: forall prim ty . PrimMonad prim
                  => MutableBlock ty (PrimState prim) -- ^ destination mutable block
                  -> Offset Word8                     -- ^ offset at destination
                  -> Block ty                         -- ^ source block
                  -> Offset Word8                     -- ^ offset at source
                  -> CountOf Word8                       -- ^ number of elements to copy
                  -> prim ()
unsafeCopyBytesRO :: forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytesRO (MutableBlock MutableByteArray# (PrimState prim)
dstMba) (Offset (I# Pinned#
d)) (Block ByteArray#
srcBa) (Offset (I# Pinned#
s)) (CountOf (I# Pinned#
n)) =
    forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
st -> (# forall d.
ByteArray#
-> Pinned#
-> MutableByteArray# d
-> Pinned#
-> Pinned#
-> State# d
-> State# d
copyByteArray# ByteArray#
srcBa Pinned#
s MutableByteArray# (PrimState prim)
dstMba Pinned#
d Pinned#
n State# (PrimState prim)
st, () #)
{-# INLINE unsafeCopyBytesRO #-}

-- | Copy a number of bytes from a Ptr to a MutableBlock with specific byte offsets
unsafeCopyBytesPtr :: forall prim ty . PrimMonad prim
                   => MutableBlock ty (PrimState prim) -- ^ destination mutable block
                   -> Offset Word8                     -- ^ offset at destination
                   -> Ptr ty                           -- ^ source block
                   -> CountOf Word8                    -- ^ number of bytes to copy
                   -> prim ()
unsafeCopyBytesPtr :: forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8 -> Ptr ty -> CountOf Word8 -> prim ()
unsafeCopyBytesPtr (MutableBlock MutableByteArray# (PrimState prim)
dstMba) (Offset (I# Pinned#
d)) (Ptr Addr#
srcBa) (CountOf (I# Pinned#
n)) =
    forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
st -> (# forall d.
Addr#
-> MutableByteArray# d
-> Pinned#
-> Pinned#
-> State# d
-> State# d
copyAddrToByteArray# Addr#
srcBa MutableByteArray# (PrimState prim)
dstMba Pinned#
d Pinned#
n State# (PrimState prim)
st, () #)
{-# INLINE unsafeCopyBytesPtr #-}

-- | read from a cell in a mutable block without bounds checking.
--
-- Reading from invalid memory can return unpredictable and invalid values.
-- use 'read' if unsure.
unsafeRead :: (PrimMonad prim, PrimType ty) => MutableBlock ty (PrimState prim) -> Offset ty -> prim ty
unsafeRead :: forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> prim ty
unsafeRead (MutableBlock MutableByteArray# (PrimState prim)
mba) Offset ty
i = forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableByteArray# (PrimState prim) -> Offset ty -> prim ty
primMbaRead MutableByteArray# (PrimState prim)
mba Offset ty
i
{-# INLINE unsafeRead #-}

-- | write to a cell in a mutable block without bounds checking.
--
-- Writing with invalid bounds will corrupt memory and your program will
-- become unreliable. use 'write' if unsure.
unsafeWrite :: (PrimMonad prim, PrimType ty) => MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite :: forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite (MutableBlock MutableByteArray# (PrimState prim)
mba) Offset ty
i ty
v = forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableByteArray# (PrimState prim) -> Offset ty -> ty -> prim ()
primMbaWrite MutableByteArray# (PrimState prim)
mba Offset ty
i ty
v
{-# INLINE unsafeWrite #-}

-- | Get a Ptr pointing to the data in the Block.
--
-- Since a Block is immutable, this Ptr shouldn't be
-- to use to modify the contents
--
-- If the Block is pinned, then its address is returned as is,
-- however if it's unpinned, a pinned copy of the Block is made
-- before getting the address.
withPtr :: PrimMonad prim
        => Block ty
        -> (Ptr ty -> prim a)
        -> prim a
withPtr :: forall (prim :: * -> *) ty a.
PrimMonad prim =>
Block ty -> (Ptr ty -> prim a) -> prim a
withPtr x :: Block ty
x@(Block ByteArray#
ba) Ptr ty -> prim a
f
    | forall ty. Block ty -> PinnedStatus
isPinned Block ty
x forall a. Eq a => a -> a -> Bool
== PinnedStatus
Pinned = Ptr ty -> prim a
f (forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
ba)) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (prim :: * -> *) ty. PrimMonad prim => Block ty -> prim ()
touch Block ty
x
    | Bool
otherwise            = do
        Block ty
arr <- prim (Block ty)
makeTrampoline
        Ptr ty -> prim a
f (forall ty. Block ty -> Ptr ty
unsafeBlockPtr Block ty
arr) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (prim :: * -> *) ty. PrimMonad prim => Block ty -> prim ()
touch Block ty
arr
  where
    makeTrampoline :: prim (Block ty)
makeTrampoline = do
        MutableBlock ty (PrimState prim)
trampoline <- forall (prim :: * -> *) ty.
PrimMonad prim =>
PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
unsafeNew PinnedStatus
Pinned (forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
x)
        forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytesRO MutableBlock ty (PrimState prim)
trampoline Offset Word8
0 Block ty
x Offset Word8
0 (forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
x)
        forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty (PrimState prim)
trampoline

touch :: PrimMonad prim => Block ty -> prim ()
touch :: forall (prim :: * -> *) ty. PrimMonad prim => Block ty -> prim ()
touch (Block ByteArray#
ba) =
    forall (prim :: * -> *) a. PrimMonad prim => IO a -> prim a
unsafePrimFromIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState IO)
s -> case touch# :: forall a. a -> State# RealWorld -> State# RealWorld
touch# ByteArray#
ba State# (PrimState IO)
s of { State# RealWorld
s2 -> (# State# RealWorld
s2, () #) }

unsafeRecast :: (PrimType t1, PrimType t2)
             => MutableBlock t1 st
             -> MutableBlock t2 st
unsafeRecast :: forall t1 t2 st.
(PrimType t1, PrimType t2) =>
MutableBlock t1 st -> MutableBlock t2 st
unsafeRecast (MutableBlock MutableByteArray# st
mba) = forall ty st. MutableByteArray# st -> MutableBlock ty st
MutableBlock MutableByteArray# st
mba

-- | Use the 'Ptr' to a mutable block in a safer construct
--
-- If the block is not pinned, this is a _dangerous_ operation
mutableWithPtr :: PrimMonad prim
                => MutableBlock ty (PrimState prim)
                -> (Ptr ty -> prim a)
                -> prim a
mutableWithPtr :: forall (prim :: * -> *) ty a.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
mutableWithPtr = forall (prim :: * -> *) ty a.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
withMutablePtr
{-# DEPRECATED mutableWithPtr "use withMutablePtr" #-}

-- | Create a pointer on the beginning of the MutableBlock
-- and call a function 'f'.
--
-- The mutable block can be mutated by the 'f' function
-- and the change will be reflected in the mutable block
--
-- If the mutable block is unpinned, a trampoline buffer
-- is created and the data is only copied when 'f' return.
--
-- it is all-in-all highly inefficient as this cause 2 copies
withMutablePtr :: PrimMonad prim
               => MutableBlock ty (PrimState prim)
               -> (Ptr ty -> prim a)
               -> prim a
withMutablePtr :: forall (prim :: * -> *) ty a.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
withMutablePtr = forall ty (prim :: * -> *) a.
PrimMonad prim =>
Bool
-> Bool
-> MutableBlock ty (PrimState prim)
-> (Ptr ty -> prim a)
-> prim a
withMutablePtrHint Bool
False Bool
False


-- | Same as 'withMutablePtr' but allow to specify 2 optimisations
-- which is only useful when the MutableBlock is unpinned and need
-- a pinned trampoline to be called safely.
--
-- If skipCopy is True, then the first copy which happen before
-- the call to 'f', is skipped. The Ptr is now effectively
-- pointing to uninitialized data in a new mutable Block.
--
-- If skipCopyBack is True, then the second copy which happen after
-- the call to 'f', is skipped. Then effectively in the case of a
-- trampoline being used the memory changed by 'f' will not
-- be reflected in the original Mutable Block.
--
-- If using the wrong parameters, it will lead to difficult to
-- debug issue of corrupted buffer which only present themselves
-- with certain Mutable Block that happened to have been allocated
-- unpinned.
--
-- If unsure use 'withMutablePtr', which default to *not* skip
-- any copy.
withMutablePtrHint :: forall ty prim a . PrimMonad prim
                   => Bool -- ^ hint that the buffer doesn't need to have the same value as the mutable block when calling f
                   -> Bool -- ^ hint that the buffer is not supposed to be modified by call of f
                   -> MutableBlock ty (PrimState prim)
                   -> (Ptr ty -> prim a)
                   -> prim a
withMutablePtrHint :: forall ty (prim :: * -> *) a.
PrimMonad prim =>
Bool
-> Bool
-> MutableBlock ty (PrimState prim)
-> (Ptr ty -> prim a)
-> prim a
withMutablePtrHint Bool
skipCopy Bool
skipCopyBack MutableBlock ty (PrimState prim)
mb Ptr ty -> prim a
f
    | forall s ty. MutableBlock s ty -> PinnedStatus
isMutablePinned MutableBlock ty (PrimState prim)
mb forall a. Eq a => a -> a -> Bool
== PinnedStatus
Pinned = MutableBlock ty (PrimState prim) -> prim a
callWithPtr MutableBlock ty (PrimState prim)
mb
    | Bool
otherwise                    = do
        MutableBlock ty (PrimState prim)
trampoline <- forall (prim :: * -> *) ty.
PrimMonad prim =>
PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
unsafeNew PinnedStatus
Pinned CountOf Word8
vecSz
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
skipCopy forall a b. (a -> b) -> a -> b
$
            forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> MutableBlock ty (PrimState prim)
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytes MutableBlock ty (PrimState prim)
trampoline Offset Word8
0 MutableBlock ty (PrimState prim)
mb Offset Word8
0 CountOf Word8
vecSz
        a
r <- MutableBlock ty (PrimState prim) -> prim a
callWithPtr MutableBlock ty (PrimState prim)
trampoline
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
skipCopyBack forall a b. (a -> b) -> a -> b
$
            forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> MutableBlock ty (PrimState prim)
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytes MutableBlock ty (PrimState prim)
mb Offset Word8
0 MutableBlock ty (PrimState prim)
trampoline Offset Word8
0 CountOf Word8
vecSz
        forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
  where
    vecSz :: CountOf Word8
vecSz = forall ty st. MutableBlock ty st -> CountOf Word8
mutableLengthBytes MutableBlock ty (PrimState prim)
mb
    callWithPtr :: MutableBlock ty (PrimState prim) -> prim a
callWithPtr MutableBlock ty (PrimState prim)
pinnedMb = do
        Block ty
b <- forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty (PrimState prim)
pinnedMb
        Ptr ty -> prim a
f (forall ty. Block ty -> Ptr ty
unsafeBlockPtr Block ty
b) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (prim :: * -> *) ty. PrimMonad prim => Block ty -> prim ()
touch Block ty
b