{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
module HsForeign.Primitive
( BA# (BA#)
, MBA# (MBA#)
, BAArray# (BAArray#)
, withPrim, allocPrim
, withPrimUnsafe
, allocPrimUnsafe
, withPrimArray
, withPrimList
, allocPrimArray
, withPrimArrayUnsafe
, allocPrimArrayUnsafe
, withPrimArrayList
, withPrimArrayListUnsafe
, withForeignPtrList
, withMutablePrimArrayContents
, withPrimArrayContents
, byteArrayContents#
, mutableByteArrayContents#
, module Data.Primitive
, module Control.Monad.Primitive
) where
import Control.Monad (foldM_)
import Control.Monad.Primitive
import Data.Primitive
import Data.Primitive.Unlifted.Array
import Foreign.ForeignPtr
import GHC.Exts
newtype BA# a = BA# ByteArray#
newtype MBA# a = MBA# (MutableByteArray# RealWorld)
newtype BAArray# a = BAArray# ArrayArray#
withPrim :: forall a b. Prim a => a -> (Ptr a -> IO b) -> IO (a, b)
withPrim :: a -> (Ptr a -> IO b) -> IO (a, b)
withPrim a
v Ptr a -> IO b
f = do
MutablePrimArray RealWorld a
buf <- Int -> IO (MutablePrimArray (PrimState IO) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newAlignedPinnedPrimArray Int
1
MutablePrimArray (PrimState IO) a -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
buf Int
0 a
v
!b
b <- MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld a
buf ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \ Ptr a
ptr -> Ptr a -> IO b
f Ptr a
ptr
!a
a <- MutablePrimArray (PrimState IO) a -> Int -> IO a
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
buf Int
0
(a, b) -> IO (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)
{-# INLINABLE withPrim #-}
allocPrim :: forall a b. Prim a => (Ptr a -> IO b) -> IO (a, b)
allocPrim :: (Ptr a -> IO b) -> IO (a, b)
allocPrim Ptr a -> IO b
f = do
MutablePrimArray RealWorld a
buf <- Int -> IO (MutablePrimArray (PrimState IO) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newAlignedPinnedPrimArray Int
1
!b
b <- MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld a
buf ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \ Ptr a
ptr -> Ptr a -> IO b
f Ptr a
ptr
!a
a <- MutablePrimArray (PrimState IO) a -> Int -> IO a
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
buf Int
0
(a, b) -> IO (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)
{-# INLINABLE allocPrim #-}
withPrimUnsafe :: (Prim a) => a -> (MBA# a -> IO b) -> IO (a, b)
withPrimUnsafe :: a -> (MBA# a -> IO b) -> IO (a, b)
withPrimUnsafe a
v MBA# a -> IO b
f = do
mpa :: MutablePrimArray RealWorld a
mpa@(MutablePrimArray MutableByteArray# RealWorld
mba#) <- Int -> IO (MutablePrimArray (PrimState IO) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
1
MutablePrimArray (PrimState IO) a -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
mpa Int
0 a
v
!b
b <- MBA# a -> IO b
f (MutableByteArray# RealWorld -> MBA# a
forall a. MutableByteArray# RealWorld -> MBA# a
MBA# MutableByteArray# RealWorld
mba#)
!a
a <- MutablePrimArray (PrimState IO) a -> Int -> IO a
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
mpa Int
0
(a, b) -> IO (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)
{-# INLINE withPrimUnsafe #-}
allocPrimUnsafe :: (Prim a) => (MBA# a -> IO b) -> IO (a, b)
allocPrimUnsafe :: (MBA# a -> IO b) -> IO (a, b)
allocPrimUnsafe MBA# a -> IO b
f = do
mpa :: MutablePrimArray RealWorld a
mpa@(MutablePrimArray MutableByteArray# RealWorld
mba#) <- Int -> IO (MutablePrimArray (PrimState IO) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
1
!b
b <- MBA# a -> IO b
f (MutableByteArray# RealWorld -> MBA# a
forall a. MutableByteArray# RealWorld -> MBA# a
MBA# MutableByteArray# RealWorld
mba#)
!a
a <- MutablePrimArray (PrimState IO) a -> Int -> IO a
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
mpa Int
0
(a, b) -> IO (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)
{-# INLINE allocPrimUnsafe #-}
withPrimArray :: (Prim a) => PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
withPrimArray :: PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
withPrimArray PrimArray a
arr Ptr a -> Int -> IO b
f
| PrimArray a -> Bool
forall a. PrimArray a -> Bool
isPrimArrayPinned PrimArray a
arr = do
let siz :: Int
siz = PrimArray a -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
arr
PrimArray a -> (Ptr a -> IO b) -> IO b
forall a b. PrimArray a -> (Ptr a -> IO b) -> IO b
withPrimArrayContents PrimArray a
arr ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> Ptr a -> Int -> IO b
f Ptr a
ptr Int
siz
| Bool
otherwise = do
let siz :: Int
siz = PrimArray a -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
arr
MutablePrimArray RealWorld a
buf <- Int -> IO (MutablePrimArray (PrimState IO) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
siz
MutablePrimArray (PrimState IO) a
-> Int -> PrimArray a -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
buf Int
0 PrimArray a
arr Int
0 Int
siz
MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld a
buf ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> Ptr a -> Int -> IO b
f Ptr a
ptr Int
siz
{-# INLINABLE withPrimArray #-}
withPrimList :: Prim a => [a] -> (Ptr a -> Int -> IO b) -> IO b
withPrimList :: [a] -> (Ptr a -> Int -> IO b) -> IO b
withPrimList = PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
forall a b. Prim a => PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
withPrimArray (PrimArray a -> (Ptr a -> Int -> IO b) -> IO b)
-> ([a] -> PrimArray a) -> [a] -> (Ptr a -> Int -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> PrimArray a
forall a. Prim a => [a] -> PrimArray a
primArrayFromList
{-# INLINABLE withPrimList #-}
allocPrimArray :: forall a b . Prim a
=> Int
-> (Ptr a -> IO b)
-> IO (PrimArray a, b)
allocPrimArray :: Int -> (Ptr a -> IO b) -> IO (PrimArray a, b)
allocPrimArray Int
len Ptr a -> IO b
f = do
MutablePrimArray RealWorld a
mpa <- Int -> IO (MutablePrimArray (PrimState IO) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newAlignedPinnedPrimArray Int
len
!b
r <- MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld a
mpa Ptr a -> IO b
f
!PrimArray a
pa <- MutablePrimArray (PrimState IO) a -> IO (PrimArray a)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
mpa
(PrimArray a, b) -> IO (PrimArray a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray a
pa, b
r)
{-# INLINABLE allocPrimArray #-}
withPrimArrayUnsafe :: (Prim a) => PrimArray a -> (BA# a -> Int -> IO b) -> IO b
withPrimArrayUnsafe :: PrimArray a -> (BA# a -> Int -> IO b) -> IO b
withPrimArrayUnsafe pa :: PrimArray a
pa@(PrimArray ByteArray#
ba#) BA# a -> Int -> IO b
f = BA# a -> Int -> IO b
f (ByteArray# -> BA# a
forall a. ByteArray# -> BA# a
BA# ByteArray#
ba#) (PrimArray a -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
pa)
{-# INLINE withPrimArrayUnsafe #-}
allocPrimArrayUnsafe
:: forall a b. Prim a => Int -> (MBA# a -> IO b) -> IO (PrimArray a, b)
allocPrimArrayUnsafe :: Int -> (MBA# a -> IO b) -> IO (PrimArray a, b)
allocPrimArrayUnsafe Int
len MBA# a -> IO b
f = do
(mpa :: MutablePrimArray RealWorld a
mpa@(MutablePrimArray MutableByteArray# RealWorld
mba#) :: MutablePrimArray RealWorld a) <- Int -> IO (MutablePrimArray (PrimState IO) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
!b
r <- MBA# a -> IO b
f (MutableByteArray# RealWorld -> MBA# a
forall a. MutableByteArray# RealWorld -> MBA# a
MBA# MutableByteArray# RealWorld
mba#)
!PrimArray a
pa <- MutablePrimArray (PrimState IO) a -> IO (PrimArray a)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
mpa
(PrimArray a, b) -> IO (PrimArray a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray a
pa, b
r)
{-# INLINE allocPrimArrayUnsafe #-}
withPrimArrayList
:: Prim a => [PrimArray a] -> (Ptr (Ptr a) -> Int -> IO b) -> IO b
withPrimArrayList :: [PrimArray a] -> (Ptr (Ptr a) -> Int -> IO b) -> IO b
withPrimArrayList [PrimArray a]
pas0 Ptr (Ptr a) -> Int -> IO b
f = do
let l :: Int
l = [PrimArray a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PrimArray a]
pas0
MutablePrimArray RealWorld (Ptr a)
ptrs <- Int -> IO (MutablePrimArray (PrimState IO) (Ptr a))
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
l
MutablePrimArray RealWorld (Ptr a) -> Int -> [PrimArray a] -> IO b
go MutablePrimArray RealWorld (Ptr a)
ptrs Int
0 [PrimArray a]
pas0
where
go :: MutablePrimArray RealWorld (Ptr a) -> Int -> [PrimArray a] -> IO b
go MutablePrimArray RealWorld (Ptr a)
ptrs !Int
_ [] = do PrimArray (Ptr a)
pa <- MutablePrimArray (PrimState IO) (Ptr a) -> IO (PrimArray (Ptr a))
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld (Ptr a)
MutablePrimArray (PrimState IO) (Ptr a)
ptrs
PrimArray (Ptr a) -> (Ptr (Ptr a) -> Int -> IO b) -> IO b
forall a b. Prim a => PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
withPrimArray PrimArray (Ptr a)
pa Ptr (Ptr a) -> Int -> IO b
f
go MutablePrimArray RealWorld (Ptr a)
ptrs !Int
i (PrimArray a
pa:[PrimArray a]
pas) =
PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
forall a b. Prim a => PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
withPrimArray PrimArray a
pa ((Ptr a -> Int -> IO b) -> IO b) -> (Ptr a -> Int -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \ Ptr a
ppa Int
_ -> do
MutablePrimArray (PrimState IO) (Ptr a) -> Int -> Ptr a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld (Ptr a)
MutablePrimArray (PrimState IO) (Ptr a)
ptrs Int
i Ptr a
ppa
MutablePrimArray RealWorld (Ptr a) -> Int -> [PrimArray a] -> IO b
go MutablePrimArray RealWorld (Ptr a)
ptrs (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [PrimArray a]
pas
{-# INLINABLE withPrimArrayList #-}
withForeignPtrList :: [ForeignPtr a] -> (Ptr (Ptr a) -> Int -> IO b) -> IO b
withForeignPtrList :: [ForeignPtr a] -> (Ptr (Ptr a) -> Int -> IO b) -> IO b
withForeignPtrList [ForeignPtr a]
fptrs Ptr (Ptr a) -> Int -> IO b
f = do
let l :: Int
l = [ForeignPtr a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ForeignPtr a]
fptrs
MutablePrimArray RealWorld (Ptr a)
ptrs <- Int -> IO (MutablePrimArray (PrimState IO) (Ptr a))
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
l
MutablePrimArray RealWorld (Ptr a) -> Int -> [ForeignPtr a] -> IO b
go MutablePrimArray RealWorld (Ptr a)
ptrs Int
0 [ForeignPtr a]
fptrs
where
go :: MutablePrimArray RealWorld (Ptr a) -> Int -> [ForeignPtr a] -> IO b
go MutablePrimArray RealWorld (Ptr a)
ptrs !Int
_ [] = do
PrimArray (Ptr a)
pa <- MutablePrimArray (PrimState IO) (Ptr a) -> IO (PrimArray (Ptr a))
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld (Ptr a)
MutablePrimArray (PrimState IO) (Ptr a)
ptrs
PrimArray (Ptr a) -> (Ptr (Ptr a) -> Int -> IO b) -> IO b
forall a b. Prim a => PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
withPrimArray PrimArray (Ptr a)
pa Ptr (Ptr a) -> Int -> IO b
f
go MutablePrimArray RealWorld (Ptr a)
ptrs !Int
i (ForeignPtr a
fp:[ForeignPtr a]
fps) = do
ForeignPtr a -> (Ptr a -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> do
MutablePrimArray (PrimState IO) (Ptr a) -> Int -> Ptr a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld (Ptr a)
MutablePrimArray (PrimState IO) (Ptr a)
ptrs Int
i Ptr a
p
MutablePrimArray RealWorld (Ptr a) -> Int -> [ForeignPtr a] -> IO b
go MutablePrimArray RealWorld (Ptr a)
ptrs (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [ForeignPtr a]
fps
withPrimArrayListUnsafe :: [PrimArray a] -> (BAArray# a -> Int -> IO b) -> IO b
withPrimArrayListUnsafe :: [PrimArray a] -> (BAArray# a -> Int -> IO b) -> IO b
withPrimArrayListUnsafe [PrimArray a]
pas BAArray# a -> Int -> IO b
f = do
let l :: Int
l = [PrimArray a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PrimArray a]
pas
MutableUnliftedArray_ RealWorld (PrimArray a) ByteArray#
mla <- Int -> IO (MutableUnliftedArray (PrimState IO) (PrimArray a))
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MutableUnliftedArray (PrimState m) a)
unsafeNewUnliftedArray Int
l
(Int -> PrimArray a -> IO Int) -> Int -> [PrimArray a] -> IO ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ (\ !Int
i PrimArray a
pa -> MutableUnliftedArray (PrimState IO) (PrimArray a)
-> Int -> PrimArray a -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> a -> m ()
writeUnliftedArray MutableUnliftedArray_ RealWorld (PrimArray a) ByteArray#
MutableUnliftedArray (PrimState IO) (PrimArray a)
mla Int
i PrimArray a
pa IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Int
0 [PrimArray a]
pas
(UnliftedArray UnliftedArray# ByteArray#
la#) <- MutableUnliftedArray (PrimState IO) (PrimArray a)
-> IO (UnliftedArray (PrimArray a))
forall (m :: * -> *) a.
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
unsafeFreezeUnliftedArray MutableUnliftedArray_ RealWorld (PrimArray a) ByteArray#
MutableUnliftedArray (PrimState IO) (PrimArray a)
mla
BAArray# a -> Int -> IO b
f (ArrayArray# -> BAArray# a
forall a. ArrayArray# -> BAArray# a
BAArray# (UnliftedArray# ByteArray# -> ArrayArray#
unsafeCoerce# UnliftedArray# ByteArray#
la#)) Int
l
{-# INLINE withPrimArrayListUnsafe #-}
#if __GLASGOW_HASKELL__ < 902
mutableByteArrayContents# :: MutableByteArray# s -> Addr#
mutableByteArrayContents# :: MutableByteArray# s -> Addr#
mutableByteArrayContents# MutableByteArray# s
mba# = ByteArray# -> Addr#
byteArrayContents# (MutableByteArray# s -> ByteArray#
unsafeCoerce# MutableByteArray# s
mba#)
{-# INLINE mutableByteArrayContents# #-}
#endif
withMutablePrimArrayContents
:: MutablePrimArray RealWorld a
-> (Ptr a -> IO b)
-> IO b
withMutablePrimArrayContents :: MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents (MutablePrimArray MutableByteArray# RealWorld
mba#) Ptr a -> IO b
f = do
let addr# :: Addr#
addr# = MutableByteArray# RealWorld -> Addr#
forall s. MutableByteArray# s -> Addr#
mutableByteArrayContents# MutableByteArray# RealWorld
mba#
ptr :: Ptr a
ptr = Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
addr#
b
b <- Ptr a -> IO b
f Ptr a
forall a. Ptr a
ptr
(State# (PrimState IO) -> State# (PrimState IO)) -> IO ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableByteArray# RealWorld -> State# RealWorld -> State# RealWorld
forall k1. k1 -> State# RealWorld -> State# RealWorld
touch# MutableByteArray# RealWorld
mba#)
b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
{-# INLINE withMutablePrimArrayContents #-}
withPrimArrayContents :: PrimArray a -> (Ptr a -> IO b) -> IO b
withPrimArrayContents :: PrimArray a -> (Ptr a -> IO b) -> IO b
withPrimArrayContents (PrimArray ByteArray#
ba#) Ptr a -> IO b
f = do
let addr# :: Addr#
addr# = ByteArray# -> Addr#
byteArrayContents# ByteArray#
ba#
ptr :: Ptr a
ptr = Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
addr#
b
b <- Ptr a -> IO b
f Ptr a
forall a. Ptr a
ptr
(State# (PrimState IO) -> State# (PrimState IO)) -> IO ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (ByteArray# -> State# RealWorld -> State# RealWorld
forall k1. k1 -> State# RealWorld -> State# RealWorld
touch# ByteArray#
ba#)
b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
{-# INLINE withPrimArrayContents #-}