{-|
Module      : Z.Foreign
Description : Use PrimArray \/ PrimVector with FFI
Copyright   : (c) Dong Han, 2017-2018
License     : BSD
Maintainer  : [email protected]
Stability   : experimental
Portability : non-portable

This module provide functions for using 'PrimArray' and 'PrimVector' with GHC FFI(Foreign function interface),
Some functions are designed to be used with <https://downloads.haskell.org/ghc/latest/docs/html/users_guide/ffi-chap.html#unlifted-ffi-types UnliftedFFITypes> extension.

GHC runtime is garbaged collected, there're 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 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 threads, which
    is dangerous. Even if you use threaded runtime and expect your haskell thread can be stolen by other OS threads,
    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
a FFI call is 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
  , allocPrimArrayUnsafe
  , withPrimVectorUnsafe
  , allocPrimVectorUnsafe
  , allocBytesUnsafe
  , withPrimUnsafe
  , allocPrimUnsafe
  , withPrimArrayListUnsafe
    -- ** Safe FFI
  , withPrimArraySafe
  , allocPrimArraySafe
  , withPrimVectorSafe
  , allocPrimVectorSafe
  , allocBytesSafe
  , withPrimSafe
  , allocPrimSafe
  , withPrimArrayListSafe
  , pinPrimArray
  , pinPrimVector
    -- ** Pointer helpers
  , BA# (..), MBA# (..), BAArray# (..)
  , clearMBA
  , clearPtr
  , castPtr
  , fromNullTerminated, fromPtr, fromPrimPtr
  , StdString, fromStdString
  -- ** convert between bytestring
  , fromByteString
  , toByteString
  -- ** re-export
  , RealWorld
  , touch
  , module Data.Primitive.ByteArray
  , module Data.Primitive.PrimArray
  , module Foreign.C.Types
  , module Data.Primitive.Ptr
  , module Z.Data.Array.Unaligned
  , withMutablePrimArrayContents, withPrimArrayContents
  -- ** Internal helpers
  , hs_std_string_size
  , hs_copy_std_string
  , hs_delete_std_string
  ) where

import           Control.Exception              (bracket)
import           Control.Monad
import           Control.Monad.Primitive
import           Data.ByteString                (ByteString)
import qualified Data.ByteString                as B
import           Data.ByteString.Short.Internal (ShortByteString (..),
                                                 fromShort, toShort)
import qualified Data.ByteString.Unsafe         as B
import qualified Data.List                      as List
import           Data.Primitive.ByteArray
import           Data.Primitive.Types
#if !MIN_VERSION_primitive(0, 9, 0)
import           Data.Primitive.PrimArray
#else
import           Data.Primitive.PrimArray       hiding
                                                (withMutablePrimArrayContents,
                                                 withPrimArrayContents)
#endif
import           Data.Primitive.Ptr
import           Data.Word
import           Foreign.C.Types
import           GHC.Exts
import           GHC.Ptr
import           Z.Data.Array.Base              (withMutablePrimArrayContents,
                                                 withPrimArrayContents)
import           Z.Data.Array.Unaligned
import           Z.Data.Array.UnliftedArray
import           Z.Data.Vector.Base

-- | Type alias for 'ByteArray#'.
--
-- Describe a 'ByteArray#' which we are going to pass across FFI. Use this type with @UnliftedFFITypes@
-- extension, 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/GHC/StgToCmm/Foreign.hs#L542 Note [Unlifted boxed arguments to foreign calls]>
--
-- 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 TYPE WITH UNSAFE FFI CALL ONLY. A 'ByteArray#' COULD BE MOVED BY GC DURING SAFE FFI CALL.
type BA# a = ByteArray#
pattern BA# :: ByteArray# -> BA# a
pattern $mBA# :: forall {r} {k} {a :: k}. BA# a -> (BA# a -> r) -> ((# #) -> r) -> r
$bBA# :: forall {k} (a :: k). BA# a -> BA# a
BA# ba = ba

-- | Type alias for 'MutableByteArray#' 'RealWorld'.
--
-- Describe a 'MutableByteArray#' which we are going to pass across FFI. Use this type with @UnliftedFFITypes@
-- extension, 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/GHC/StgToCmm/Foreign.hs#L542 Note [Unlifted boxed arguments to foreign calls]>
--
-- USE THIS TYPE WITH UNSAFE FFI CALL ONLY. A 'MutableByteArray#' COULD BE MOVED BY GC DURING SAFE FFI CALL.
type MBA# a = MutableByteArray# RealWorld
pattern MBA# :: MutableByteArray# RealWorld -> MBA# a
pattern $mMBA# :: forall {r} {k} {a :: k}.
MBA# a -> (MBA# a -> r) -> ((# #) -> r) -> r
$bMBA# :: forall {k} (a :: k). MBA# a -> MBA# a
MBA# mba = mba

-- | Type alias for 'ArrayArray#'.
--
-- Describe a array of 'ByteArray#' which we are going to pass across FFI. Use this type with @UnliftedFFITypes@
-- extension, At C side you should use @StgArrBytes**@(>=8.10) or @StgMutArrPtrs*@(<8.10) type from "Rts.h",
-- example code modified from
-- <https://downloads.haskell.org/ghc/latest/docs/html/users_guide/ffi-chap.html#unlifted-ffi-types GHC manual>:
--
-- @
-- \/\/ C source, must include the RTS to make the struct StgArrBytes
-- \/\/ available along with its fields: ptrs and payload.
-- #include "Rts.h"
-- // GHC 8.10 changes the way how ArrayArray# is passed to C, so...
-- #if \_\_GLASGOW_HASKELL\_\_ < 810
-- HsInt sum_first (StgMutArrPtrs *arr, HsInt len) {
--   StgArrBytes **bufs = (StgArrBytes**)arr->payload;
-- #else
-- HsInt sum_first (StgArrBytes **bufs, HsInt len) {
-- #endif
--   int res = 0;
--   for(StgWord ix = 0;ix < len;ix++) {
--      // payload pointer type is StgWord*, cast it before use!
--      res = res + ((HsInt*)(bufs[ix]->payload))[0];
--   }
--   return res;
-- }
--
-- -- Haskell source, all elements in the argument array must be
-- -- either ByteArray\# or MutableByteArray\#. This is not enforced
-- -- by the type system in this example since ArrayArray is untyped.
-- foreign import ccall unsafe "sum_first" sumFirst :: BAArray# Int -> Int -> IO CInt
-- @
type BAArray# a = ArrayArray#
pattern BAArray# :: ArrayArray# -> BAArray# a
pattern $mBAArray# :: forall {r} {k} {a :: k}.
BAArray# a -> (BAArray# a -> r) -> ((# #) -> r) -> r
$bBAArray# :: forall {k} (a :: k). BAArray# a -> BAArray# a
BAArray# baa = baa

-- | Clear 'MBA#' with given length to zero.
clearMBA :: MBA# a
         -> Int  -- ^ in bytes
         -> IO ()
{-# INLINE clearMBA #-}
clearMBA :: forall {k} (a :: k). MBA# a -> Int -> IO ()
clearMBA (MBA# MBA# a
mba#) Int
len =
    MutableByteArray (PrimState IO) -> Int -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray (MBA# a -> MutableByteArray RealWorld
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MBA# a
mba#) Int
0 Int
len (Word8
0 :: Word8)

-- | Pass primitive array to unsafe FFI as pointer.
--
-- Enable 'UnliftedFFITypes' extension in your haskell code, use proper pointer type and @HsInt@
-- to marshall @ByteArray#@ and @Int@ arguments on C side.
--
-- The second 'Int' arguement is the element size not the bytes size.
--
-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
withPrimArrayUnsafe :: (Prim a) => PrimArray a -> (BA# a -> Int -> IO b) -> IO b
{-# INLINE withPrimArrayUnsafe #-}
withPrimArrayUnsafe :: forall a b. Prim a => 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# a
forall {k} (a :: k). BA# a -> BA# a
BA# BA# a
ba#) (PrimArray a -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
pa)

-- | Pass primitive array list to unsafe FFI as @StgArrBytes**@.
--
-- Enable 'UnliftedFFITypes' extension in your haskell code, use @StgArrBytes**@(>=8.10)
-- or @StgMutArrPtrs*@(<8.10) pointer type and @HsInt@
-- to marshall @BAArray#@ and @Int@ arguments on C side, check the example with 'BAArray#'.
--
-- The second 'Int' arguement is the list size.
--
-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
withPrimArrayListUnsafe :: [PrimArray a] -> (BAArray# a -> Int -> IO b) -> IO b
{-# INLINE withPrimArrayListUnsafe #-}
withPrimArrayListUnsafe :: forall a b. [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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [PrimArray a]
pas
    MutableUnliftedArray RealWorld (PrimArray a)
mla <- Int -> IO (MutableUnliftedArray (PrimState IO) (PrimArray a))
forall {k} (m :: * -> *) (a :: k).
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)
MutableUnliftedArray (PrimState IO) (PrimArray a)
mla Int
i PrimArray a
pa IO () -> IO Int -> IO Int
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) Int
0 [PrimArray a]
pas
    (UnliftedArray BAArray# a
la#) <- MutableUnliftedArray (PrimState IO) (PrimArray a)
-> IO (UnliftedArray (PrimArray a))
forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
unsafeFreezeUnliftedArray MutableUnliftedArray RealWorld (PrimArray a)
MutableUnliftedArray (PrimState IO) (PrimArray a)
mla
    BAArray# a -> Int -> IO b
f (BAArray# a -> BAArray# a
forall {k} (a :: k). BAArray# a -> BAArray# a
BAArray# BAArray# a
la#) Int
l

-- | Allocate some bytes and pass to FFI as pointer, freeze result into a 'PrimArray'.
--
-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
allocPrimArrayUnsafe :: forall a b. Prim a => Int -> (MBA# a -> IO b) -> IO (PrimArray a, b)
{-# INLINE allocPrimArrayUnsafe #-}
allocPrimArrayUnsafe :: forall a b.
Prim a =>
Int -> (MBA# a -> IO b) -> IO (PrimArray a, b)
allocPrimArrayUnsafe Int
len MBA# a -> IO b
f = do
    (mpa :: MutablePrimArray RealWorld a
mpa@(MutablePrimArray MBA# a
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 (MBA# a -> MBA# a
forall {k} (a :: k). MBA# a -> MBA# a
MBA# MBA# a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray a
pa, b
r)

-- | 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 :: forall a b.
Prim a =>
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

-- | Allocate a prim array and pass to FFI as pointer, freeze result into a 'PrimVector'.
--
-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
allocPrimVectorUnsafe :: forall a b. Prim a => Int  -- ^ number of elements
                      -> (MBA# a -> IO b) -> IO (PrimVector a, b)
{-# INLINE allocPrimVectorUnsafe #-}
allocPrimVectorUnsafe :: forall a b.
Prim a =>
Int -> (MBA# a -> IO b) -> IO (PrimVector a, b)
allocPrimVectorUnsafe Int
len MBA# a -> IO b
f = do
    (mpa :: MutablePrimArray RealWorld a
mpa@(MutablePrimArray MBA# a
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 (MBA# a -> MBA# a
forall {k} (a :: k). MBA# a -> MBA# a
MBA# MBA# a
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
    let !v :: PrimVector a
v = PrimArray a -> Int -> Int -> PrimVector a
forall a. PrimArray a -> Int -> Int -> PrimVector a
PrimVector PrimArray a
pa Int
0 Int
len
    (PrimVector a, b) -> IO (PrimVector a, b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimVector a
v, b
r)

-- | Allocate some bytes and pass to FFI as pointer, freeze result into a 'Bytes'.
--
-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
allocBytesUnsafe :: Int  -- ^ number of bytes
                 -> (MBA# Word8 -> IO b) -> IO (Bytes, b)
{-# INLINE allocBytesUnsafe #-}
allocBytesUnsafe :: forall b. Int -> (MBA# a -> IO b) -> IO (Bytes, b)
allocBytesUnsafe = Int -> (MBA# a -> IO b) -> IO (Bytes, b)
forall a b.
Prim a =>
Int -> (MBA# a -> IO b) -> IO (PrimVector a, b)
allocPrimVectorUnsafe

-- | 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 :: forall a b. Prim a => 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# a
forall {k} (a :: k). MBA# a -> MBA# a
MBA# 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)

-- | like 'withPrimUnsafe', but don't write initial value.
--
-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
allocPrimUnsafe :: (Prim a) => (MBA# a -> IO b) -> IO (a, b)
{-# INLINE allocPrimUnsafe #-}
allocPrimUnsafe :: forall a b. Prim a => (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# a
forall {k} (a :: k). MBA# a -> MBA# a
MBA# 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 a. a -> IO a
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 @HsInt@ to marshall @Ptr a@ and @Int@ arguments on C side.
-- The memory pointed by 'Ptr a' will not moved during call. After call returned, pointer is no longer valid.
--
-- 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
{-# INLINABLE withPrimArraySafe #-}
withPrimArraySafe :: forall a b. Prim a => 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 primitive array list to safe FFI as pointer.
--
-- Use proper pointer type and @HsInt@ to marshall @Ptr (Ptr a)@ and @Int@ arguments on C side.
-- The memory pointed by 'Ptr a' will not moved during call. After call returned, pointer is no longer valid.
--
-- The second 'Int' arguement is the list size.
--
-- Don't pass a forever loop to this function, see <https://ghc.haskell.org/trac/ghc/ticket/14346 #14346>.
withPrimArrayListSafe :: Prim a => [PrimArray a] -> (Ptr (Ptr a) -> Int -> IO b) -> IO b
withPrimArrayListSafe :: forall a b.
Prim a =>
[PrimArray a] -> (Ptr (Ptr a) -> Int -> IO b) -> IO b
withPrimArrayListSafe [PrimArray a]
pas0 Ptr (Ptr a) -> Int -> IO b
f = do
    let l :: Int
l = [PrimArray a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.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
withPrimArraySafe 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) =
        -- It's important to nest 'withPrimArraySafe' calls to keep all pointers alive
        PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
forall a b. Prim a => PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
withPrimArraySafe 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

-- | Allocate a prim array and pass to FFI as pointer, freeze result into a 'PrimVector'.
allocPrimArraySafe :: forall a b . Prim a
                    => Int      -- ^ in elements
                    -> (Ptr a -> IO b)
                    -> IO (PrimArray a, b)
{-# INLINABLE allocPrimArraySafe #-}
allocPrimArraySafe :: forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO (PrimArray a, b)
allocPrimArraySafe 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray a
pa, b
r)

-- | Pass 'PrimVector' to safe FFI as pointer
--
-- The 'PrimVector' version of 'withPrimArraySafe'. The 'Ptr' is already pointed
-- to the first element, thus no offset is provided. After call returned, pointer is no longer valid.
--
-- 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
{-# INLINABLE withPrimVectorSafe #-}
withPrimVectorSafe :: forall a b.
Prim a =>
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 a
ptr' = Ptr a
ptr Ptr a -> Int -> Ptr a
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
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)
{-# INLINABLE withPrimSafe #-}
withPrimSafe :: forall a b. Prim a => 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)

-- | like 'withPrimSafe', but don't write initial value.
allocPrimSafe :: forall a b. Prim a => (Ptr a -> IO b) -> IO (a, b)
{-# INLINABLE allocPrimSafe #-}
allocPrimSafe :: forall a b. Prim a => (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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)

-- | Allocate a prim array and pass to FFI as pointer, freeze result into a 'PrimVector'.
allocPrimVectorSafe :: forall a b . Prim a
                    => Int      -- ^ in elements
                    -> (Ptr a -> IO b) -> IO (PrimVector a, b)
{-# INLINABLE allocPrimVectorSafe #-}
allocPrimVectorSafe :: forall a b.
Prim a =>
Int -> (Ptr a -> IO b) -> IO (PrimVector a, b)
allocPrimVectorSafe 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
    let !v :: PrimVector a
v = PrimArray a -> Int -> Int -> PrimVector a
forall a. PrimArray a -> Int -> Int -> PrimVector a
PrimVector PrimArray a
pa Int
0 Int
len
    (PrimVector a, b) -> IO (PrimVector a, b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimVector a
v, b
r)

-- | Allocate some bytes and pass to FFI as pointer, freeze result into a 'PrimVector'.
allocBytesSafe :: Int      -- ^ in bytes
               -> (Ptr Word8 -> IO b) -> IO (Bytes, b)
{-# INLINABLE allocBytesSafe #-}
allocBytesSafe :: forall b. Int -> (Ptr Word8 -> IO b) -> IO (Bytes, b)
allocBytesSafe = Int -> (Ptr Word8 -> IO b) -> IO (Bytes, b)
forall a b.
Prim a =>
Int -> (Ptr a -> IO b) -> IO (PrimVector a, b)
allocPrimVectorSafe

-- | Convert a 'PrimArray' to a pinned one(memory won't moved by GC) if necessary.
pinPrimArray :: Prim a => PrimArray a -> IO (PrimArray a)
{-# INLINABLE pinPrimArray #-}
pinPrimArray :: forall a. Prim a => PrimArray a -> IO (PrimArray a)
pinPrimArray PrimArray a
arr
    | PrimArray a -> Bool
forall a. PrimArray a -> Bool
isPrimArrayPinned PrimArray a
arr = PrimArray a -> IO (PrimArray a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PrimArray a
arr
    | Bool
otherwise = do
        let l :: Int
l = 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
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
0 Int
l
        PrimArray a
arr' <- 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
buf
        PrimArray a -> IO (PrimArray a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PrimArray a
arr'

-- | Convert a 'PrimVector' to a pinned one(memory won't moved by GC) if necessary.
pinPrimVector :: Prim a => PrimVector a -> IO (PrimVector a)
{-# INLINABLE pinPrimVector #-}
pinPrimVector :: forall a. Prim a => PrimVector a -> IO (PrimVector a)
pinPrimVector v :: PrimVector a
v@(PrimVector PrimArray a
pa Int
s Int
l)
    | PrimArray a -> Bool
forall a. PrimArray a -> Bool
isPrimArrayPinned PrimArray a
pa = PrimVector a -> IO (PrimVector a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PrimVector a
v
    | 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
pa Int
s Int
l
        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
buf
        PrimVector a -> IO (PrimVector a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray a -> Int -> Int -> PrimVector a
forall a. PrimArray a -> Int -> Int -> PrimVector a
PrimVector PrimArray a
pa' Int
0 Int
l)

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

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, the length
-- should be given in bytes.
--
clearPtr :: Ptr a -> Int -> IO ()
{-# INLINABLE clearPtr #-}
clearPtr :: forall a. 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)

-- | Copy some bytes from a null terminated pointer(without copying the null terminator).
--
-- You should consider using 'Z.Data.CBytes.CBytes' type for storing NULL terminated bytes first,
-- This method is provided if you really need to read 'Bytes', there's no encoding guarantee,
-- result could be any bytes sequence.
fromNullTerminated :: Ptr a -> IO Bytes
{-# INLINABLE fromNullTerminated #-}
fromNullTerminated :: forall a. Ptr a -> IO Bytes
fromNullTerminated (Ptr Addr#
addr#) = do
    Int
len <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Addr# -> IO CSize
c_strlen Addr#
addr#
    MutablePrimArray RealWorld Word8
marr <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
    MutablePrimArray (PrimState IO) Word8
-> Int -> Ptr Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
0 (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
len
    PrimArray Word8
arr <- MutablePrimArray (PrimState IO) Word8 -> IO (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr
    Bytes -> IO Bytes
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
PrimVector PrimArray Word8
arr Int
0 Int
len)

-- | Copy some bytes from a pointer.
--
-- There's no encoding guarantee, result could be any bytes sequence.
fromPtr :: Ptr a -> Int -- ^ in bytes
        -> IO Bytes
{-# INLINABLE fromPtr #-}
fromPtr :: forall a. Ptr a -> Int -> IO Bytes
fromPtr (Ptr Addr#
addr#) Int
len = do
    MutablePrimArray RealWorld Word8
marr <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
    MutablePrimArray (PrimState IO) Word8
-> Int -> Ptr Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
0 (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
len
    PrimArray Word8
arr <- MutablePrimArray (PrimState IO) Word8 -> IO (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr
    Bytes -> IO Bytes
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
PrimVector PrimArray Word8
arr Int
0 Int
len)

-- | Copy some bytes from a pointer.
--
-- There's no encoding guarantee, result could be any bytes sequence.
fromPrimPtr :: forall a. Prim a
            => Ptr a -> Int -- ^  in elements
            -> IO (PrimVector a)
{-# INLINABLE fromPrimPtr #-}
fromPrimPtr :: forall a. Prim a => Ptr a -> Int -> IO (PrimVector a)
fromPrimPtr (Ptr Addr#
addr#) Int
len = do
    MutablePrimArray RealWorld a
marr <- Int -> IO (MutablePrimArray (PrimState IO) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
    MutablePrimArray (PrimState IO) a -> Int -> Ptr a -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr Int
0 (Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
len
    PrimArray a
arr <- 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
marr
    PrimVector a -> IO (PrimVector a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray a -> Int -> Int -> PrimVector a
forall a. PrimArray a -> Int -> Int -> PrimVector a
PrimVector PrimArray a
arr Int
0 Int
len)

-- | @std::string@ Pointer tag.
data StdString

-- | Run FFI in bracket and marshall @std::string*@ result into Haskell heap bytes,
-- memory pointed by @std::string*@ will be @delete@ ed.
fromStdString :: IO (Ptr StdString) -> IO Bytes
{-# INLINABLE fromStdString #-}
fromStdString :: IO (Ptr StdString) -> IO Bytes
fromStdString IO (Ptr StdString)
f = IO (Ptr StdString)
-> (Ptr StdString -> IO ())
-> (Ptr StdString -> IO Bytes)
-> IO Bytes
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Ptr StdString)
f Ptr StdString -> IO ()
hs_delete_std_string
    (\ Ptr StdString
q -> do
        Int
siz <- Ptr StdString -> IO Int
hs_std_string_size Ptr StdString
q
        (Bytes
bs,()
_) <- Int -> (MBA# a -> IO ()) -> IO (Bytes, ())
forall b. Int -> (MBA# a -> IO b) -> IO (Bytes, b)
allocBytesUnsafe Int
siz (Ptr StdString -> Int -> MBA# a -> IO ()
hs_copy_std_string Ptr StdString
q Int
siz)
        Bytes -> IO Bytes
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
bs)

foreign import ccall unsafe hs_std_string_size :: Ptr StdString -> IO Int
foreign import ccall unsafe hs_copy_std_string :: Ptr StdString -> Int -> MBA# Word8 -> IO ()
foreign import ccall unsafe hs_delete_std_string :: Ptr StdString -> IO ()

-- | O(n), Convert from 'ByteString'.
fromByteString :: ByteString -> Bytes
{-# INLINABLE fromByteString #-}
fromByteString :: ByteString -> Bytes
fromByteString ByteString
bs = case ByteString -> ShortByteString
toShort ByteString
bs of
    (SBS BA# a
ba#) -> PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
PrimVector (BA# a -> PrimArray Word8
forall a. BA# a -> PrimArray a
PrimArray BA# a
ba#) Int
0 (ByteString -> Int
B.length ByteString
bs)

-- | O(n), Convert tp 'ByteString'.
toByteString :: Bytes -> ByteString
{-# INLINABLE toByteString #-}
toByteString :: Bytes -> ByteString
toByteString (PrimVector (PrimArray BA# a
ba#) Int
s Int
l) = Int -> ByteString -> ByteString
B.unsafeTake Int
l (ByteString -> ByteString)
-> (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.unsafeDrop Int
s (ByteString -> ByteString)
-> (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
fromShort (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ BA# a -> ShortByteString
SBS BA# a
ba#