module Dahdit.Mem
  ( MemPtr (..)
  , emptyMemPtr
  , MutableMem (..)
  , ReadMem (..)
  , readSBSMem
  , viewSBSMem
  , viewBSMem
  , viewVecMem
  , mutViewVecMem
  , WriteMem (..)
  , writeSBSMem
  , withBAMem
  , withSBSMem
  , withVecMem
  , withBSMem
  )
where

import Control.Monad.Primitive (MonadPrim, PrimMonad (..), RealWorld)
import Dahdit.LiftedPrim (LiftedPrim (..), setByteArrayLifted)
import Dahdit.Proxy (proxyFor)
import Dahdit.Sizes (ByteCount (..), staticByteSize)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Internal as BSI
import Data.ByteString.Short.Internal (ShortByteString (..))
import Data.Coerce (coerce)
import Data.Foldable (for_)
import Data.Primitive.ByteArray
  ( ByteArray (..)
  , MutableByteArray
  , cloneByteArray
  , copyByteArray
  , copyByteArrayToPtr
  , freezeByteArray
  , newByteArray
  , unsafeFreezeByteArray
  , unsafeThawByteArray
  )
import Data.Primitive.Ptr (copyPtrToMutableByteArray)
import Data.Vector.Storable (Vector)
import qualified Data.Vector.Storable as VS
import Data.Vector.Storable.Mutable (IOVector)
import qualified Data.Vector.Storable.Mutable as VSM
import Data.Word (Word8)
import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrBytes, withForeignPtr)
import Foreign.Ptr (Ptr, plusPtr)

data MemPtr s = MemPtr
  { forall s. MemPtr s -> ForeignPtr Word8
mpForeign :: !(ForeignPtr Word8)
  , forall s. MemPtr s -> ByteCount
mpOffset :: !ByteCount
  , forall s. MemPtr s -> ByteCount
mpLength :: !ByteCount
  }
  deriving stock (MemPtr s -> MemPtr s -> Bool
forall s. MemPtr s -> MemPtr s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemPtr s -> MemPtr s -> Bool
$c/= :: forall s. MemPtr s -> MemPtr s -> Bool
== :: MemPtr s -> MemPtr s -> Bool
$c== :: forall s. MemPtr s -> MemPtr s -> Bool
Eq, MemPtr s -> MemPtr s -> Bool
MemPtr s -> MemPtr s -> Ordering
forall s. Eq (MemPtr s)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall s. MemPtr s -> MemPtr s -> Bool
forall s. MemPtr s -> MemPtr s -> Ordering
forall s. MemPtr s -> MemPtr s -> MemPtr s
min :: MemPtr s -> MemPtr s -> MemPtr s
$cmin :: forall s. MemPtr s -> MemPtr s -> MemPtr s
max :: MemPtr s -> MemPtr s -> MemPtr s
$cmax :: forall s. MemPtr s -> MemPtr s -> MemPtr s
>= :: MemPtr s -> MemPtr s -> Bool
$c>= :: forall s. MemPtr s -> MemPtr s -> Bool
> :: MemPtr s -> MemPtr s -> Bool
$c> :: forall s. MemPtr s -> MemPtr s -> Bool
<= :: MemPtr s -> MemPtr s -> Bool
$c<= :: forall s. MemPtr s -> MemPtr s -> Bool
< :: MemPtr s -> MemPtr s -> Bool
$c< :: forall s. MemPtr s -> MemPtr s -> Bool
compare :: MemPtr s -> MemPtr s -> Ordering
$ccompare :: forall s. MemPtr s -> MemPtr s -> Ordering
Ord, Int -> MemPtr s -> ShowS
forall s. Int -> MemPtr s -> ShowS
forall s. [MemPtr s] -> ShowS
forall s. MemPtr s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemPtr s] -> ShowS
$cshowList :: forall s. [MemPtr s] -> ShowS
show :: MemPtr s -> String
$cshow :: forall s. MemPtr s -> String
showsPrec :: Int -> MemPtr s -> ShowS
$cshowsPrec :: forall s. Int -> MemPtr s -> ShowS
Show)

emptyMemPtr :: IO (MemPtr RealWorld)
emptyMemPtr :: IO (MemPtr RealWorld)
emptyMemPtr = ByteCount -> IO (MemPtr RealWorld)
allocPtrMem ByteCount
0

withMemPtr :: MemPtr RealWorld -> (Ptr Word8 -> IO a) -> IO a
withMemPtr :: forall a. MemPtr RealWorld -> (Ptr Word8 -> IO a) -> IO a
withMemPtr (MemPtr ForeignPtr Word8
fp ByteCount
off ByteCount
_) Ptr Word8 -> IO a
f = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp (\Ptr Word8
ptr -> Ptr Word8 -> IO a
f (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off)))

class (PrimMonad m) => MutableMem r w m | w m -> r where
  unsafeThawMem :: r -> m w
  unsafeUseThawedMem :: r -> (w -> m a) -> m a
  unsafeUseThawedMem r
r w -> m a
f = forall r w (m :: * -> *). MutableMem r w m => r -> m w
unsafeThawMem r
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> m a
f
  unsafeFreezeMem :: w -> m r
  unsafeUseFrozenMem :: w -> (r -> m a) -> m a
  unsafeUseFrozenMem w
w r -> m a
f = forall r w (m :: * -> *). MutableMem r w m => w -> m r
unsafeFreezeMem w
w forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= r -> m a
f

instance (MonadPrim s m) => MutableMem ByteArray (MutableByteArray s) m where
  unsafeThawMem :: ByteArray -> m (MutableByteArray s)
unsafeThawMem = forall (m :: * -> *).
PrimMonad m =>
ByteArray -> m (MutableByteArray (PrimState m))
unsafeThawByteArray
  unsafeFreezeMem :: MutableByteArray s -> m ByteArray
unsafeFreezeMem = forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray

instance MutableMem (VS.Vector Word8) (IOVector Word8) IO where
  unsafeThawMem :: Vector Word8 -> IO (IOVector Word8)
unsafeThawMem = forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
Vector a -> m (MVector (PrimState m) a)
VS.unsafeThaw
  unsafeFreezeMem :: IOVector Word8 -> IO (Vector Word8)
unsafeFreezeMem = forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VS.unsafeFreeze

class (PrimMonad m) => ReadMem r m where
  indexMemInBytes :: (LiftedPrim a) => r -> ByteCount -> m a
  cloneArrayMemInBytes :: r -> ByteCount -> ByteCount -> m ByteArray

instance (PrimMonad m) => ReadMem ByteArray m where
  indexMemInBytes :: forall a. LiftedPrim a => ByteArray -> ByteCount -> m a
indexMemInBytes ByteArray
arr ByteCount
off = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr ByteCount
off)
  cloneArrayMemInBytes :: ByteArray -> ByteCount -> ByteCount -> m ByteArray
cloneArrayMemInBytes ByteArray
arr ByteCount
off ByteCount
len = forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray -> Int -> Int -> ByteArray
cloneByteArray ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
len))

cloneMemPtr :: MemPtr RealWorld -> ByteCount -> ByteCount -> IO ByteArray
cloneMemPtr :: MemPtr RealWorld -> ByteCount -> ByteCount -> IO ByteArray
cloneMemPtr MemPtr RealWorld
mem ByteCount
off ByteCount
len = do
  MutableByteArray RealWorld
marr <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
len)
  forall a. MemPtr RealWorld -> (Ptr Word8 -> IO a) -> IO a
withMemPtr MemPtr RealWorld
mem forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
    let wptr :: Ptr Word8
wptr = forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) :: Ptr Word8
    forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> Ptr a -> Int -> m ()
copyPtrToMutableByteArray MutableByteArray RealWorld
marr Int
0 Ptr Word8
wptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
len)
  forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray RealWorld
marr

instance ReadMem (MemPtr RealWorld) IO where
  indexMemInBytes :: forall a. LiftedPrim a => MemPtr RealWorld -> ByteCount -> IO a
indexMemInBytes MemPtr RealWorld
mem ByteCount
off = forall a. MemPtr RealWorld -> (Ptr Word8 -> IO a) -> IO a
withMemPtr MemPtr RealWorld
mem (\Ptr Word8
ptr -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. LiftedPrim a => Ptr Word8 -> ByteCount -> a
indexPtrLiftedInBytes Ptr Word8
ptr ByteCount
off))
  cloneArrayMemInBytes :: MemPtr RealWorld -> ByteCount -> ByteCount -> IO ByteArray
cloneArrayMemInBytes = MemPtr RealWorld -> ByteCount -> ByteCount -> IO ByteArray
cloneMemPtr

readSBSMem :: (ReadMem r m) => r -> ByteCount -> ByteCount -> m ShortByteString
readSBSMem :: forall r (m :: * -> *).
ReadMem r m =>
r -> ByteCount -> ByteCount -> m ShortByteString
readSBSMem r
mem ByteCount
off ByteCount
len = do
  ByteArray ByteArray#
frozArr <- forall r (m :: * -> *).
ReadMem r m =>
r -> ByteCount -> ByteCount -> m ByteArray
cloneArrayMemInBytes r
mem ByteCount
off ByteCount
len
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray# -> ShortByteString
SBS ByteArray#
frozArr)

viewSBSMem :: ShortByteString -> ByteArray
viewSBSMem :: ShortByteString -> ByteArray
viewSBSMem (SBS ByteArray#
harr) = ByteArray# -> ByteArray
ByteArray ByteArray#
harr

viewBSMem :: ByteString -> MemPtr RealWorld
viewBSMem :: ByteString -> MemPtr RealWorld
viewBSMem ByteString
bs = let (ForeignPtr Word8
fp, Int
off, Int
len) = ByteString -> (ForeignPtr Word8, Int, Int)
BSI.toForeignPtr ByteString
bs in forall s. ForeignPtr Word8 -> ByteCount -> ByteCount -> MemPtr s
MemPtr ForeignPtr Word8
fp (coerce :: forall a b. Coercible a b => a -> b
coerce Int
off) (coerce :: forall a b. Coercible a b => a -> b
coerce Int
len)

viewVecMem :: Vector Word8 -> MemPtr RealWorld
viewVecMem :: Vector Word8 -> MemPtr RealWorld
viewVecMem Vector Word8
vec = let (ForeignPtr Word8
fp, Int
off, Int
len) = forall a. Vector a -> (ForeignPtr a, Int, Int)
VS.unsafeToForeignPtr Vector Word8
vec in forall s. ForeignPtr Word8 -> ByteCount -> ByteCount -> MemPtr s
MemPtr ForeignPtr Word8
fp (coerce :: forall a b. Coercible a b => a -> b
coerce Int
off) (coerce :: forall a b. Coercible a b => a -> b
coerce Int
len)

mutViewVecMem :: IOVector Word8 -> MemPtr RealWorld
mutViewVecMem :: IOVector Word8 -> MemPtr RealWorld
mutViewVecMem IOVector Word8
mvec = let (ForeignPtr Word8
fp, Int
off, Int
len) = forall s a. MVector s a -> (ForeignPtr a, Int, Int)
VSM.unsafeToForeignPtr IOVector Word8
mvec in forall s. ForeignPtr Word8 -> ByteCount -> ByteCount -> MemPtr s
MemPtr ForeignPtr Word8
fp (coerce :: forall a b. Coercible a b => a -> b
coerce Int
off) (coerce :: forall a b. Coercible a b => a -> b
coerce Int
len)

class (PrimMonad m) => WriteMem q m where
  writeMemInBytes :: (LiftedPrim a) => a -> q (PrimState m) -> ByteCount -> m ()
  copyArrayMemInBytes :: ByteArray -> ByteCount -> ByteCount -> q (PrimState m) -> ByteCount -> m ()
  setMemInBytes :: (LiftedPrim a) => ByteCount -> a -> q (PrimState m) -> ByteCount -> m ()

instance (PrimMonad m) => WriteMem MutableByteArray m where
  writeMemInBytes :: forall a.
LiftedPrim a =>
a -> MutableByteArray (PrimState m) -> ByteCount -> m ()
writeMemInBytes a
val MutableByteArray (PrimState m)
mem ByteCount
off = forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> ByteCount -> a -> m ()
writeArrayLiftedInBytes MutableByteArray (PrimState m)
mem ByteCount
off a
val
  copyArrayMemInBytes :: ByteArray
-> ByteCount
-> ByteCount
-> MutableByteArray (PrimState m)
-> ByteCount
-> m ()
copyArrayMemInBytes ByteArray
arr ByteCount
arrOff ByteCount
arrLen MutableByteArray (PrimState m)
mem ByteCount
off = forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
copyByteArray MutableByteArray (PrimState m)
mem (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
arrOff) (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
arrLen)
  setMemInBytes :: forall a.
LiftedPrim a =>
ByteCount
-> a -> MutableByteArray (PrimState m) -> ByteCount -> m ()
setMemInBytes ByteCount
len a
val MutableByteArray (PrimState m)
mem ByteCount
off = forall (m :: * -> *) a.
(PrimMonad m, LiftedPrim a) =>
MutableByteArray (PrimState m)
-> ByteCount -> ByteCount -> a -> m ()
setByteArrayLifted MutableByteArray (PrimState m)
mem ByteCount
off ByteCount
len a
val

copyPtr :: (PrimMonad m) => ByteArray -> ByteCount -> ByteCount -> Ptr Word8 -> ByteCount -> m ()
copyPtr :: forall (m :: * -> *).
PrimMonad m =>
ByteArray
-> ByteCount -> ByteCount -> Ptr Word8 -> ByteCount -> m ()
copyPtr ByteArray
arr ByteCount
arrOff ByteCount
arrLen Ptr Word8
ptr ByteCount
off =
  let wptr :: Ptr Word8
wptr = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off)) :: Ptr Word8
  in  forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> ByteArray -> Int -> Int -> m ()
copyByteArrayToPtr Ptr Word8
wptr ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
arrOff) (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
arrLen)

setPtr :: (PrimMonad m, LiftedPrim a) => ByteCount -> a -> Ptr Word8 -> ByteCount -> m ()
setPtr :: forall (m :: * -> *) a.
(PrimMonad m, LiftedPrim a) =>
ByteCount -> a -> Ptr Word8 -> ByteCount -> m ()
setPtr ByteCount
len a
val Ptr Word8
ptr ByteCount
off = do
  let elemSize :: ByteCount
elemSize = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall a. a -> Proxy a
proxyFor a
val)
      elemLen :: ByteCount
elemLen = forall a. Integral a => a -> a -> a
div (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
len) ByteCount
elemSize
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ByteCount
0 .. ByteCount
elemLen forall a. Num a => a -> a -> a
- ByteCount
1] forall a b. (a -> b) -> a -> b
$ \ByteCount
pos ->
    forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
Ptr Word8 -> ByteCount -> a -> m ()
writePtrLiftedInBytes Ptr Word8
ptr (ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
pos forall a. Num a => a -> a -> a
* ByteCount
elemSize) a
val

instance WriteMem MemPtr IO where
  writeMemInBytes :: forall a.
LiftedPrim a =>
a -> MemPtr (PrimState IO) -> ByteCount -> IO ()
writeMemInBytes a
val MemPtr (PrimState IO)
mem ByteCount
off = forall a. MemPtr RealWorld -> (Ptr Word8 -> IO a) -> IO a
withMemPtr MemPtr (PrimState IO)
mem (\Ptr Word8
ptr -> forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
Ptr Word8 -> ByteCount -> a -> m ()
writePtrLiftedInBytes Ptr Word8
ptr ByteCount
off a
val)
  copyArrayMemInBytes :: ByteArray
-> ByteCount
-> ByteCount
-> MemPtr (PrimState IO)
-> ByteCount
-> IO ()
copyArrayMemInBytes ByteArray
arr ByteCount
arrOff ByteCount
arrLen MemPtr (PrimState IO)
mem ByteCount
off = forall a. MemPtr RealWorld -> (Ptr Word8 -> IO a) -> IO a
withMemPtr MemPtr (PrimState IO)
mem (\Ptr Word8
ptr -> forall (m :: * -> *).
PrimMonad m =>
ByteArray
-> ByteCount -> ByteCount -> Ptr Word8 -> ByteCount -> m ()
copyPtr ByteArray
arr ByteCount
arrOff ByteCount
arrLen Ptr Word8
ptr ByteCount
off)
  setMemInBytes :: forall a.
LiftedPrim a =>
ByteCount -> a -> MemPtr (PrimState IO) -> ByteCount -> IO ()
setMemInBytes ByteCount
len a
val MemPtr (PrimState IO)
mem ByteCount
off = forall a. MemPtr RealWorld -> (Ptr Word8 -> IO a) -> IO a
withMemPtr MemPtr (PrimState IO)
mem (\Ptr Word8
ptr -> forall (m :: * -> *) a.
(PrimMonad m, LiftedPrim a) =>
ByteCount -> a -> Ptr Word8 -> ByteCount -> m ()
setPtr ByteCount
len a
val Ptr Word8
ptr ByteCount
off)

writeSBSMem :: (WriteMem q m) => ShortByteString -> ByteCount -> q (PrimState m) -> ByteCount -> m ()
writeSBSMem :: forall (q :: * -> *) (m :: * -> *).
WriteMem q m =>
ShortByteString
-> ByteCount -> q (PrimState m) -> ByteCount -> m ()
writeSBSMem (SBS ByteArray#
harr) = forall (q :: * -> *) (m :: * -> *).
WriteMem q m =>
ByteArray
-> ByteCount -> ByteCount -> q (PrimState m) -> ByteCount -> m ()
copyArrayMemInBytes (ByteArray# -> ByteArray
ByteArray ByteArray#
harr) ByteCount
0

withBAMem :: (MonadPrim s m) => ByteCount -> (MutableByteArray s -> m ByteCount) -> m ByteArray
withBAMem :: forall s (m :: * -> *).
MonadPrim s m =>
ByteCount -> (MutableByteArray s -> m ByteCount) -> m ByteArray
withBAMem ByteCount
len MutableByteArray s -> m ByteCount
use = do
  MutableByteArray s
marr <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
len)
  ByteCount
len' <- MutableByteArray s -> m ByteCount
use MutableByteArray s
marr
  if ByteCount
len' forall a. Eq a => a -> a -> Bool
== ByteCount
len
    then forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
marr
    else forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Int -> m ByteArray
freezeByteArray MutableByteArray s
marr Int
0 (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
len')

withSBSMem :: (MonadPrim s m) => ByteCount -> (MutableByteArray s -> m ByteCount) -> m ShortByteString
withSBSMem :: forall s (m :: * -> *).
MonadPrim s m =>
ByteCount
-> (MutableByteArray s -> m ByteCount) -> m ShortByteString
withSBSMem ByteCount
len MutableByteArray s -> m ByteCount
use = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ByteArray ByteArray#
arr) -> ByteArray# -> ShortByteString
SBS ByteArray#
arr) (forall s (m :: * -> *).
MonadPrim s m =>
ByteCount -> (MutableByteArray s -> m ByteCount) -> m ByteArray
withBAMem ByteCount
len MutableByteArray s -> m ByteCount
use)

allocPtrMem :: ByteCount -> IO (MemPtr RealWorld)
allocPtrMem :: ByteCount -> IO (MemPtr RealWorld)
allocPtrMem ByteCount
len = do
  ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
len)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall s. ForeignPtr Word8 -> ByteCount -> ByteCount -> MemPtr s
MemPtr ForeignPtr Word8
fp ByteCount
0 ByteCount
len)

freezeVecMem :: MemPtr RealWorld -> ByteCount -> Vector Word8
freezeVecMem :: MemPtr RealWorld -> ByteCount -> Vector Word8
freezeVecMem (MemPtr ForeignPtr Word8
fp ByteCount
off ByteCount
_) ByteCount
len =
  forall a. Storable a => ForeignPtr a -> Int -> Int -> Vector a
VS.unsafeFromForeignPtr ForeignPtr Word8
fp (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) (coerce :: forall a b. Coercible a b => a -> b
coerce (ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
len))

freezeBSMem :: MemPtr RealWorld -> ByteCount -> ByteString
freezeBSMem :: MemPtr RealWorld -> ByteCount -> ByteString
freezeBSMem (MemPtr ForeignPtr Word8
fp ByteCount
off ByteCount
_) ByteCount
len =
  ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr ForeignPtr Word8
fp (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) (coerce :: forall a b. Coercible a b => a -> b
coerce (ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
len))

withVecMem :: ByteCount -> (MemPtr RealWorld -> IO ByteCount) -> IO (Vector Word8)
withVecMem :: ByteCount
-> (MemPtr RealWorld -> IO ByteCount) -> IO (Vector Word8)
withVecMem ByteCount
len MemPtr RealWorld -> IO ByteCount
use = do
  MemPtr RealWorld
mem <- ByteCount -> IO (MemPtr RealWorld)
allocPtrMem ByteCount
len
  ByteCount
len' <- MemPtr RealWorld -> IO ByteCount
use MemPtr RealWorld
mem
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemPtr RealWorld -> ByteCount -> Vector Word8
freezeVecMem MemPtr RealWorld
mem ByteCount
len')

withBSMem :: ByteCount -> (MemPtr RealWorld -> IO ByteCount) -> IO ByteString
withBSMem :: ByteCount -> (MemPtr RealWorld -> IO ByteCount) -> IO ByteString
withBSMem ByteCount
len MemPtr RealWorld -> IO ByteCount
use = do
  MemPtr RealWorld
mem <- ByteCount -> IO (MemPtr RealWorld)
allocPtrMem ByteCount
len
  ByteCount
len' <- MemPtr RealWorld -> IO ByteCount
use MemPtr RealWorld
mem
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemPtr RealWorld -> ByteCount -> ByteString
freezeBSMem MemPtr RealWorld
mem ByteCount
len')