{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-|
Module      : Z.Foreign
Description : Use PrimArray with FFI
Copyright   : (c) Dong Han, 2017-2018
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module provide functions for using 'PrimArray' and 'PrimVector' with GHC FFI(Foreign function interface).
Since GHC runtime is garbaged collected, we have a quite complex story when passing primitive arrays to FFI.
We have two types of primitive array in GHC, with the objective to minimize overall memory management cost:

  * Small primitive arrays created with 'newPrimArray' are directly allocated on GHC heap, which can be moved
    by GHC garbage collector, we call these arrays @unpinned@. Allocating these array is cheap, we only need
    to check heap limit and bump heap pointer just like any other haskell heap objects. But we will pay GC cost
    , which is OK for small arrays.

  * Large primitive array and those created with 'newPinnedPrimArray' are allocated on GHC managed memory blocks,
    which is also traced by garbage collector, but will never moved before freed, thus are called @pinned@.
    Allocating these arrays are bit more expensive since it's more like how @malloc@ works, but we don't have to
    pay for GC cost.

Beside the @pinned/unpinned@ difference, we also have two types of FFI calls in GHC:

  * Safe FFI call annotated with @safe@ keyword. These calls are executed on separated OS thread, which can be
    running concurrently with GHC garbage collector, thus we want to make sure only pinned arrays are passed.
    The main use case for @safe@ FFIs are long running functions, for example, doing IO polling.
    Since these calls are running on separated OS thread, haskell thread on original OS thread will not be affected.

  * Unsafe FFI call annotated with @unsafe@ keyword. These calls are executed on the same OS thread which is
    running the haskell side FFI code, which will in turn stop GHC from doing a garbage collection. We can pass
    both 'pinned' and 'unpinned' arrays in this case. The use case for @unsafe@ FFIs are short/small functions,
    which can be treated like a fat primitive operations, such as @memcpy@, @memcmp@. Using @unsafe@ FFI with
    long running functions will effectively block GHC runtime thread from running any other haskell thread, which
    is dangerous. Even if you use threaded runtime and expect your haskell thread can be stolen by other OS thread,
    but this will not work since GHC garbage collector will refuse to run if one of the OS thread is blocked by
    FFI calls.

Base on above analysis, we have following FFI strategy table.

  +--------------+---------------+---------------+
  | FFI  \ Array |    pinned     |   unpinned    |
  +--------------+---------------+---------------+
  |   unsafe     | directly pass | directly pass |
  +--------------+---------------+---------------+
  |     safe     | directly pass |  make a copy  |
  +--------------+---------------+---------------+

In this module, we separate safe and unsafe FFI handling due to the strategy difference: if the user can guarantee
the FFI are unsafe, we can save an extra copy and pinned allocation. Mistakenly using unsafe function with safe FFI
will result in segfault.

-}

module Z.Foreign
  ( -- ** Unsafe FFI
    withPrimArrayUnsafe
  , withMutablePrimArrayUnsafe
  , allocMutableByteArrayUnsafe
  , withPrimVectorUnsafe
  , withPrimUnsafe
  , allocPrimUnsafe
    -- ** Safe FFI
  , withPrimArraySafe
  , withMutablePrimArraySafe
  , allocMutablePrimArraySafe
  , withPrimVectorSafe
  , withPrimSafe
  , allocPrimSafe
    -- ** Pointer helpers
  , BA#, MBA#
  , clearPtr
  , castPtr
  -- ** re-export
  , module Data.Primitive.Ptr
  ) where

import           Control.Monad.Primitive
import           Data.Primitive
import           Data.Primitive.Ptr
import           Foreign.C.Types
import           GHC.Ptr
import           Z.Data.Array
import           Z.Data.Vector.Base

-- | Type alias for 'ByteArray#'.
--
-- Since we can't newtype an unlifted type yet, type alias is the best we can get
-- to describe a 'ByteArray#' which we are going to pass across FFI. At C side you
-- should use a proper const pointer type.
--
-- Don't cast 'BA#' to 'Addr#' since the heap object offset is hard-coded in code generator:
-- <https://github.com/ghc/ghc/blob/master/compiler/codeGen/StgCmmForeign.hs#L520>
--
-- USE THIS TYPE WITH UNSAFE FFI CALL ONLY.
-- A 'ByteArray#' COULD BE MOVED BY GC DURING SAFE FFI CALL.
type BA# a = ByteArray#

-- | Type alias for 'MutableByteArray#' 'RealWorld'.
--
-- Since we can't newtype an unlifted type yet, type alias is the best we can get
-- to describe a 'MutableByteArray#' which we are going to pass across FFI. At C side you
-- should use a proper pointer type.
--
-- Don't cast 'MBA#' to 'Addr#' since the heap object offset is hard-coded in code generator:
-- <https://github.com/ghc/ghc/blob/master/compiler/codeGen/StgCmmForeign.hs#L520>
--
-- USE THIS TYPE WITH UNSAFE FFI CALL ONLY.
-- A 'MutableByteArray#' COULD BE MOVED BY GC DURING SAFE FFI CALL.
type MBA# a = MutableByteArray# RealWorld

-- | Pass primitive array to unsafe FFI as pointer.
--
-- Enable 'UnliftedFFITypes' extension in your haskell code, use proper pointer type and @CSize/CSsize@
-- to marshall @ByteArray#@ and @Int@ arguments on C side.
--
-- The second 'Int' arguement is the element size not the bytes size.
--
-- Don't cast 'ByteArray#' to 'Addr#' since the heap object offset is hard-coded in code generator:
-- <https://github.com/ghc/ghc/blob/master/compiler/codeGen/StgCmmForeign.hs#L520>
--
-- In haskell side we use type system to distinguish immutable / mutable arrays, but in C side we can't.
-- So it's users' responsibility to make sure the array content is not mutated (a const pointer type may help).
--
-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
--
withPrimArrayUnsafe :: (Prim a) => PrimArray a -> (BA# a -> Int -> IO b) -> IO b
{-# INLINE withPrimArrayUnsafe #-}
withPrimArrayUnsafe :: PrimArray a -> (BA# a -> Int -> IO b) -> IO b
withPrimArrayUnsafe pa :: PrimArray a
pa@(PrimArray BA# a
ba#) BA# a -> Int -> IO b
f = BA# a -> Int -> IO b
f BA# a
ba# (PrimArray a -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
pa)

-- | Pass mutable primitive array to unsafe FFI as pointer.
--
-- The mutable version of 'withPrimArrayUnsafe'.
--
-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
--
withMutablePrimArrayUnsafe :: (Prim a) => MutablePrimArray RealWorld a
                           -> (MBA# a -> Int -> IO b) -> IO b
{-# INLINE withMutablePrimArrayUnsafe #-}
withMutablePrimArrayUnsafe :: MutablePrimArray RealWorld a -> (MBA# a -> Int -> IO b) -> IO b
withMutablePrimArrayUnsafe mpa :: MutablePrimArray RealWorld a
mpa@(MutablePrimArray MBA# a
mba#) MBA# a -> Int -> IO b
f =
    MutablePrimArray (PrimState IO) a -> IO Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
mpa IO Int -> (Int -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MBA# a -> Int -> IO b
f MBA# a
mba#

allocMutableByteArrayUnsafe :: Int      -- ^ In bytes not element
                            -> (MBA# a -> IO b) -> IO b
{-# INLINE allocMutableByteArrayUnsafe #-}
allocMutableByteArrayUnsafe :: Int -> (MBA# a -> IO b) -> IO b
allocMutableByteArrayUnsafe Int
len MBA# a -> IO b
f = do
    (MutableByteArray MBA# a
mba#) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
len
    MBA# a -> IO b
f MBA# a
mba#

-- | Pass 'PrimVector' to unsafe FFI as pointer
--
-- The 'PrimVector' version of 'withPrimArrayUnsafe'.
--
-- The second 'Int' arguement is the first element offset, the third 'Int' argument is the
-- element length.
--
-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
--
withPrimVectorUnsafe :: (Prim a)
                     => PrimVector a -> (BA# a -> Int -> Int -> IO b) -> IO b
{-# INLINE withPrimVectorUnsafe #-}
withPrimVectorUnsafe :: PrimVector a -> (BA# a -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe (PrimVector PrimArray a
arr Int
s Int
l) BA# a -> Int -> Int -> IO b
f = PrimArray a -> (BA# a -> Int -> IO b) -> IO b
forall a b. Prim a => PrimArray a -> (BA# a -> Int -> IO b) -> IO b
withPrimArrayUnsafe PrimArray a
arr ((BA# a -> Int -> IO b) -> IO b) -> (BA# a -> Int -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \ BA# a
ba# Int
_ -> BA# a -> Int -> Int -> IO b
f BA# a
ba# Int
s Int
l


-- | Create an one element primitive array and use it as a pointer to the primitive element.
--
-- Return the element and the computation result.
--
-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
--
withPrimUnsafe :: (Prim a)
               => a -> (MBA# a -> IO b) -> IO (a, b)
{-# INLINE withPrimUnsafe #-}
withPrimUnsafe :: a -> (MBA# a -> IO b) -> IO (a, b)
withPrimUnsafe a
v MBA# a -> IO b
f = do
    mpa :: MutablePrimArray RealWorld a
mpa@(MutablePrimArray MBA# a
mba#) <- Int -> IO (MutablePrimArray (PrimState IO) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
1    -- All heap objects are WORD aligned
    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 MBA# a
mba#                                      -- so no need to do extra alignment
    !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)

allocPrimUnsafe :: (Prim a) => (MBA# a -> IO b) -> IO (a, b)
{-# INLINE allocPrimUnsafe #-}
allocPrimUnsafe :: (MBA# a -> IO b) -> IO (a, b)
allocPrimUnsafe MBA# a -> IO b
f = do
    mpa :: MutablePrimArray RealWorld a
mpa@(MutablePrimArray MBA# a
mba#) <- Int -> IO (MutablePrimArray (PrimState IO) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
1    -- All heap objects are WORD aligned
    !b
b <- MBA# a -> IO b
f MBA# a
mba#                                      -- so no need to do extra alignment
    !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)

--------------------------------------------------------------------------------

-- | Pass primitive array to safe FFI as pointer.
--
-- Use proper pointer type and @CSize/CSsize@ to marshall @Ptr a@ and @Int@ arguments on C side.
-- The memory pointed by 'Ptr a' will not moved.
--
-- The second 'Int' arguement is the element size not the bytes size.
--
-- Don't pass a forever loop to this function, see <https://ghc.haskell.org/trac/ghc/ticket/14346 #14346>.
withPrimArraySafe :: (Prim a) => PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
{-# INLINE withPrimArraySafe #-}
withPrimArraySafe :: PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
withPrimArraySafe 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


-- | Pass mutable primitive array to unsafe FFI as pointer.
--
-- The mutable version of 'withPrimArraySafe'.
--
-- Don't pass a forever loop to this function, see <https://ghc.haskell.org/trac/ghc/ticket/14346 #14346>.
withMutablePrimArraySafe :: (Prim a) => MutablePrimArray RealWorld a -> (Ptr a -> Int -> IO b) -> IO b
{-# INLINE withMutablePrimArraySafe #-}
withMutablePrimArraySafe :: MutablePrimArray RealWorld a -> (Ptr a -> Int -> IO b) -> IO b
withMutablePrimArraySafe MutablePrimArray RealWorld a
marr Ptr a -> Int -> IO b
f
    | MutablePrimArray RealWorld a -> Bool
forall s a. MutablePrimArray s a -> Bool
isMutablePrimArrayPinned MutablePrimArray RealWorld a
marr = do
        Int
siz <- MutablePrimArray (PrimState IO) a -> IO Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr
        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
marr ((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
        Int
siz <- MutablePrimArray (PrimState IO) a -> IO Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr
        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 -> MutablePrimArray (PrimState IO) a -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
buf Int
0 MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr 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

allocMutablePrimArraySafe :: (Prim a) => Int -- ^ in number of elements not bytes
                          -> (Ptr a -> IO b) -> IO b
{-# INLINE allocMutablePrimArraySafe #-}
allocMutablePrimArraySafe :: Int -> (Ptr a -> IO b) -> IO b
allocMutablePrimArraySafe Int
siz 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)
newPinnedPrimArray 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
f

-- | Pass 'PrimVector' to unsafe FFI as pointer
--
-- The 'PrimVector' version of 'withPrimArraySafe'. The 'Ptr' is already pointed
-- to the first element, thus no offset is provided.
--
-- Don't pass a forever loop to this function, see <https://ghc.haskell.org/trac/ghc/ticket/14346 #14346>.
withPrimVectorSafe :: forall a b. Prim a => PrimVector a -> (Ptr a -> Int -> IO b) -> IO b
{-# INLINE withPrimVectorSafe #-}
withPrimVectorSafe :: PrimVector a -> (Ptr a -> Int -> IO b) -> IO b
withPrimVectorSafe (PrimVector PrimArray a
arr Int
s Int
l) Ptr a -> Int -> IO b
f
    | PrimArray a -> Bool
forall a. PrimArray a -> Bool
isPrimArrayPinned 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 ->
            let ptr' :: Ptr b
ptr' = Ptr a
ptr Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
siz) in Ptr a -> Int -> IO b
f Ptr a
forall b. Ptr b
ptr' Int
l
    | Bool
otherwise = do
        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
l
        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
s Int
l
        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
l
  where
    siz :: Int
siz = a -> Int
forall a. Prim a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)

-- | Create an one element primitive array and use it as a pointer to the primitive element.
--
-- Don't pass a forever loop to this function, see <https://ghc.haskell.org/trac/ghc/ticket/14346 #14346>.
withPrimSafe :: forall a b. Prim a => a -> (Ptr a -> IO b) -> IO (a, b)
{-# INLINE withPrimSafe #-}
withPrimSafe :: a -> (Ptr a -> IO b) -> IO (a, b)
withPrimSafe 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)

allocPrimSafe :: forall a b. Prim a => (Ptr a -> IO b) -> IO (a, b)
{-# INLINE allocPrimSafe #-}
allocPrimSafe :: (Ptr a -> IO b) -> IO (a, b)
allocPrimSafe 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)

--------------------------------------------------------------------------------

foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO ()

-- | Zero a structure.
--
-- There's no 'Storable' or 'Prim' constraint on 'a' type, thus the length
-- should be given in bytes.
--
clearPtr :: Ptr a -> Int -> IO ()
{-# INLINE clearPtr #-}
clearPtr :: Ptr a -> Int -> IO ()
clearPtr Ptr a
dest Int
nbytes = Ptr a -> CInt -> CSize -> IO ()
forall a. Ptr a -> CInt -> CSize -> IO ()
memset Ptr a
dest CInt
0 (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nbytes)