{-# LANGUAGE InstanceSigs #-}

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.Sizes (ByteCount (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString.Internal as BSI
import Data.ByteString.Short.Internal (ShortByteString (..))
import Data.Foldable (for_)
import Data.Primitive (Prim (..), sizeOfType)
import Data.Primitive.ByteArray
  ( ByteArray (..)
  , MutableByteArray
  , cloneByteArray
  , copyByteArray
  , copyByteArrayToPtr
  , freezeByteArray
  , newByteArray
  , setByteArray
  , unsafeFreezeByteArray
  , unsafeThawByteArray
  )
import Data.Primitive.ByteArray.Unaligned (PrimUnaligned, indexUnalignedByteArray, writeUnalignedByteArray)
import Data.Primitive.Ptr (copyPtrToMutableByteArray, indexOffPtr, writeOffPtr)
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, castPtr, 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
(MemPtr s -> MemPtr s -> Bool)
-> (MemPtr s -> MemPtr s -> Bool) -> Eq (MemPtr s)
forall s. MemPtr s -> MemPtr s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
Eq, Eq (MemPtr s)
Eq (MemPtr s) =>
(MemPtr s -> MemPtr s -> Ordering)
-> (MemPtr s -> MemPtr s -> Bool)
-> (MemPtr s -> MemPtr s -> Bool)
-> (MemPtr s -> MemPtr s -> Bool)
-> (MemPtr s -> MemPtr s -> Bool)
-> (MemPtr s -> MemPtr s -> MemPtr s)
-> (MemPtr s -> MemPtr s -> MemPtr s)
-> Ord (MemPtr s)
MemPtr s -> MemPtr s -> Bool
MemPtr s -> MemPtr s -> Ordering
MemPtr s -> MemPtr s -> MemPtr s
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
$ccompare :: forall s. MemPtr s -> MemPtr s -> Ordering
compare :: MemPtr s -> MemPtr s -> Ordering
$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
>= :: MemPtr s -> MemPtr s -> Bool
$cmax :: forall s. MemPtr s -> MemPtr s -> MemPtr s
max :: MemPtr s -> MemPtr s -> MemPtr s
$cmin :: forall s. MemPtr s -> MemPtr s -> MemPtr s
min :: MemPtr s -> MemPtr s -> MemPtr s
Ord, Int -> MemPtr s -> ShowS
[MemPtr s] -> ShowS
MemPtr s -> String
(Int -> MemPtr s -> ShowS)
-> (MemPtr s -> String) -> ([MemPtr s] -> ShowS) -> Show (MemPtr s)
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
$cshowsPrec :: forall s. Int -> MemPtr s -> ShowS
showsPrec :: Int -> MemPtr s -> ShowS
$cshow :: forall s. MemPtr s -> String
show :: MemPtr s -> String
$cshowList :: forall s. [MemPtr s] -> ShowS
showList :: [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 = ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp (\Ptr Word8
ptr -> Ptr Word8 -> IO a
f (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr (ByteCount -> Int
unByteCount 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 = r -> m w
forall r w (m :: * -> *). MutableMem r w m => r -> m w
unsafeThawMem r
r m w -> (w -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
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 = w -> m r
forall r w (m :: * -> *). MutableMem r w m => w -> m r
unsafeFreezeMem w
w m r -> (r -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
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 = ByteArray -> m (MutableByteArray s)
ByteArray -> m (MutableByteArray (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
ByteArray -> m (MutableByteArray (PrimState m))
unsafeThawByteArray
  unsafeFreezeMem :: MutableByteArray s -> m ByteArray
unsafeFreezeMem = MutableByteArray s -> m ByteArray
MutableByteArray (PrimState m) -> m ByteArray
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 = Vector Word8 -> IO (IOVector Word8)
Vector Word8 -> IO (MVector (PrimState IO) Word8)
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
Vector a -> m (MVector (PrimState m) a)
VS.unsafeThaw
  unsafeFreezeMem :: IOVector Word8 -> IO (Vector Word8)
unsafeFreezeMem = IOVector Word8 -> IO (Vector Word8)
MVector (PrimState IO) Word8 -> IO (Vector Word8)
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VS.unsafeFreeze

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

instance (PrimMonad m) => ReadMem ByteArray m where
  indexMemInBytes :: forall a.
(Prim a, PrimUnaligned a) =>
ByteArray -> ByteCount -> m a
indexMemInBytes ByteArray
arr ByteCount
off = a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray -> Int -> a
forall a. PrimUnaligned a => ByteArray -> Int -> a
indexUnalignedByteArray ByteArray
arr (ByteCount -> Int
unByteCount ByteCount
off))
  cloneArrayMemInBytes :: ByteArray -> ByteCount -> ByteCount -> m ByteArray
cloneArrayMemInBytes ByteArray
arr ByteCount
off ByteCount
len = ByteArray -> m ByteArray
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray -> Int -> Int -> ByteArray
cloneByteArray ByteArray
arr (ByteCount -> Int
unByteCount ByteCount
off) (ByteCount -> Int
unByteCount 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 <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (ByteCount -> Int
unByteCount ByteCount
len)
  MemPtr RealWorld -> (Ptr Word8 -> IO ()) -> IO ()
forall a. MemPtr RealWorld -> (Ptr Word8 -> IO a) -> IO a
withMemPtr MemPtr RealWorld
mem ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
    let wptr :: Ptr Word8
wptr = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr (ByteCount -> Int
unByteCount ByteCount
off) :: Ptr Word8
    MutableByteArray (PrimState IO) -> Int -> Ptr Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> Ptr a -> Int -> m ()
copyPtrToMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
marr Int
0 Ptr Word8
wptr (ByteCount -> Int
unByteCount ByteCount
len)
  MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
marr

instance ReadMem (MemPtr RealWorld) IO where
  indexMemInBytes :: forall a. (Prim a) => MemPtr RealWorld -> ByteCount -> IO a
  indexMemInBytes :: forall a. Prim a => MemPtr RealWorld -> ByteCount -> IO a
indexMemInBytes MemPtr RealWorld
mem ByteCount
off = MemPtr RealWorld -> (Ptr Word8 -> IO a) -> IO a
forall a. MemPtr RealWorld -> (Ptr Word8 -> IO a) -> IO a
withMemPtr MemPtr RealWorld
mem ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
    let wptr :: Ptr a
wptr = Ptr Word8 -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr (ByteCount -> Int
unByteCount ByteCount
off)
    in  a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr a -> Int -> a
forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr a
wptr Int
0)
  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 <- r -> ByteCount -> ByteCount -> m ByteArray
forall r (m :: * -> *).
ReadMem r m =>
r -> ByteCount -> ByteCount -> m ByteArray
cloneArrayMemInBytes r
mem ByteCount
off ByteCount
len
  ShortByteString -> m ShortByteString
forall a. a -> m a
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 ForeignPtr Word8 -> ByteCount -> ByteCount -> MemPtr RealWorld
forall s. ForeignPtr Word8 -> ByteCount -> ByteCount -> MemPtr s
MemPtr ForeignPtr Word8
fp (Int -> ByteCount
ByteCount Int
off) (Int -> ByteCount
ByteCount Int
len)

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

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

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

instance (PrimMonad m) => WriteMem MutableByteArray m where
  writeMemInBytes :: forall a.
(Prim a, PrimUnaligned a) =>
a -> MutableByteArray (PrimState m) -> ByteCount -> m ()
writeMemInBytes a
val MutableByteArray (PrimState m)
mem ByteCount
off = MutableByteArray (PrimState m) -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, PrimUnaligned a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeUnalignedByteArray MutableByteArray (PrimState m)
mem (ByteCount -> Int
unByteCount 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 = MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
copyByteArray MutableByteArray (PrimState m)
mem (ByteCount -> Int
unByteCount ByteCount
off) ByteArray
arr (ByteCount -> Int
unByteCount ByteCount
arrOff) (ByteCount -> Int
unByteCount ByteCount
arrLen)
  setMemInBytes :: forall a.
(Prim a, PrimUnaligned a) =>
ByteCount
-> a -> MutableByteArray (PrimState m) -> ByteCount -> m ()
setMemInBytes ByteCount
len a
val MutableByteArray (PrimState m)
mem ByteCount
off = MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray (PrimState m)
mem (ByteCount -> Int
unByteCount ByteCount
off) (ByteCount -> Int
unByteCount 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 = Ptr Any -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr (ByteCount -> Int
unByteCount ByteCount
off)) :: Ptr Word8
  in  Ptr Word8 -> ByteArray -> Int -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> ByteArray -> Int -> Int -> m ()
copyByteArrayToPtr Ptr Word8
wptr ByteArray
arr (ByteCount -> Int
unByteCount ByteCount
arrOff) (ByteCount -> Int
unByteCount ByteCount
arrLen)

setPtr :: forall m a. (PrimMonad m, Prim a) => ByteCount -> a -> Ptr Word8 -> ByteCount -> m ()
setPtr :: forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
ByteCount -> a -> Ptr Word8 -> ByteCount -> m ()
setPtr (ByteCount Int
len) a
val Ptr Word8
ptr (ByteCount Int
off) = do
  let elemSize :: Int
elemSize = forall a. Prim a => Int
sizeOfType @a
      elemLen :: Int
elemLen = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
len Int
elemSize
  [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0 .. Int
elemLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
pos ->
    let wptr :: Ptr a
wptr = Ptr Word8 -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
elemSize)
    in  Ptr a -> Int -> a -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr a
wptr Int
0 a
val

instance WriteMem MemPtr IO where
  writeMemInBytes :: forall a.
(Prim a, PrimUnaligned a) =>
a -> MemPtr (PrimState IO) -> ByteCount -> IO ()
writeMemInBytes a
val MemPtr (PrimState IO)
mem ByteCount
off = MemPtr RealWorld -> (Ptr Word8 -> IO ()) -> IO ()
forall a. MemPtr RealWorld -> (Ptr Word8 -> IO a) -> IO a
withMemPtr MemPtr RealWorld
MemPtr (PrimState IO)
mem ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
    let wptr :: Ptr a
wptr = Ptr Word8 -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr (ByteCount -> Int
unByteCount ByteCount
off)
    in  Ptr a -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr a
wptr Int
0 a
val
  copyArrayMemInBytes :: ByteArray
-> ByteCount
-> ByteCount
-> MemPtr (PrimState IO)
-> ByteCount
-> IO ()
copyArrayMemInBytes ByteArray
arr ByteCount
arrOff ByteCount
arrLen MemPtr (PrimState IO)
mem ByteCount
off = MemPtr RealWorld -> (Ptr Word8 -> IO ()) -> IO ()
forall a. MemPtr RealWorld -> (Ptr Word8 -> IO a) -> IO a
withMemPtr MemPtr RealWorld
MemPtr (PrimState IO)
mem (\Ptr Word8
ptr -> ByteArray
-> ByteCount -> ByteCount -> Ptr Word8 -> ByteCount -> IO ()
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.
(Prim a, PrimUnaligned a) =>
ByteCount -> a -> MemPtr (PrimState IO) -> ByteCount -> IO ()
setMemInBytes ByteCount
len a
val MemPtr (PrimState IO)
mem ByteCount
off = MemPtr RealWorld -> (Ptr Word8 -> IO ()) -> IO ()
forall a. MemPtr RealWorld -> (Ptr Word8 -> IO a) -> IO a
withMemPtr MemPtr RealWorld
MemPtr (PrimState IO)
mem (\Ptr Word8
ptr -> ByteCount -> a -> Ptr Word8 -> ByteCount -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim 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) = ByteArray
-> ByteCount -> ByteCount -> q (PrimState m) -> ByteCount -> m ()
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 <- Int -> m (MutableByteArray (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (ByteCount -> Int
unByteCount ByteCount
len)
  ByteCount
len' <- MutableByteArray s -> m ByteCount
use MutableByteArray s
marr
  if ByteCount
len' ByteCount -> ByteCount -> Bool
forall a. Eq a => a -> a -> Bool
== ByteCount
len
    then MutableByteArray (PrimState m) -> m ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState m)
marr
    else MutableByteArray (PrimState m) -> Int -> Int -> m ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Int -> m ByteArray
freezeByteArray MutableByteArray s
MutableByteArray (PrimState m)
marr Int
0 (ByteCount -> Int
unByteCount 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 = (ByteArray -> ShortByteString) -> m ByteArray -> m ShortByteString
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ByteArray ByteArray#
arr) -> ByteArray# -> ShortByteString
SBS ByteArray#
arr) (ByteCount -> (MutableByteArray s -> m ByteCount) -> m ByteArray
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 <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (ByteCount -> Int
unByteCount ByteCount
len)
  MemPtr RealWorld -> IO (MemPtr RealWorld)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr Word8 -> ByteCount -> ByteCount -> MemPtr RealWorld
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 =
  ForeignPtr Word8 -> Int -> Int -> Vector Word8
forall a. Storable a => ForeignPtr a -> Int -> Int -> Vector a
VS.unsafeFromForeignPtr ForeignPtr Word8
fp (ByteCount -> Int
unByteCount ByteCount
off) (ByteCount -> Int
unByteCount (ByteCount
off ByteCount -> ByteCount -> ByteCount
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 (ByteCount -> Int
unByteCount ByteCount
off) (ByteCount -> Int
unByteCount (ByteCount
off ByteCount -> ByteCount -> ByteCount
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
  Vector Word8 -> IO (Vector Word8)
forall a. a -> IO a
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
  ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemPtr RealWorld -> ByteCount -> ByteString
freezeBSMem MemPtr RealWorld
mem ByteCount
len')