module Z.Foreign
(
withPrimArrayUnsafe
, allocPrimArrayUnsafe
, withPrimVectorUnsafe
, allocPrimVectorUnsafe
, allocBytesUnsafe
, withPrimUnsafe
, allocPrimUnsafe
, withPrimArrayListUnsafe
, withPrimArraySafe
, allocPrimArraySafe
, withPrimVectorSafe
, allocPrimVectorSafe
, allocBytesSafe
, withPrimSafe
, allocPrimSafe
, withPrimArrayListSafe
, pinPrimArray
, pinPrimVector
, BA# (..), MBA# (..), BAArray# (..)
, clearMBA
, clearPtr
, castPtr
, fromNullTerminated, fromPtr, fromPrimPtr
, StdString, fromStdString
, fromByteString
, toByteString
, 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
, 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
import Data.Primitive.ByteArray
import Data.Primitive.PrimArray
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 BA# a = ByteArray#
pattern BA# :: ByteArray# -> BA# a
pattern $bBA# :: forall {k} (a :: k). BA# a -> BA# a
$mBA# :: forall {r} {k} {a :: k}. BA# a -> (BA# a -> r) -> ((# #) -> r) -> r
BA# ba = ba
type MBA# a = MutableByteArray# RealWorld
pattern MBA# :: MutableByteArray# RealWorld -> MBA# a
pattern $bMBA# :: forall {k} (a :: k). MBA# a -> MBA# a
$mMBA# :: forall {r} {k} {a :: k}.
MBA# a -> (MBA# a -> r) -> ((# #) -> r) -> r
MBA# mba = mba
type BAArray# a = ArrayArray#
pattern BAArray# :: ArrayArray# -> BAArray# a
pattern $bBAArray# :: forall {k} (a :: k). BAArray# a -> BAArray# a
$mBAArray# :: forall {r} {k} {a :: k}.
BAArray# a -> (BAArray# a -> r) -> ((# #) -> r) -> r
BAArray# baa = baa
clearMBA :: MBA# a
-> Int
-> IO ()
{-# INLINE clearMBA #-}
clearMBA :: forall {k} (a :: k). MBA# a -> Int -> IO ()
clearMBA (MBA# MBA# a
mba#) Int
len =
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray (forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MBA# a
mba#) Int
0 Int
len (Word8
0 :: Word8)
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 (forall {k} (a :: k). BA# a -> BA# a
BA# BA# a
ba#) (forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
pa)
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 = forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [PrimArray a]
pas
MutableUnliftedArray RealWorld (PrimArray a)
mla <- forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
Int -> m (MutableUnliftedArray (PrimState m) a)
unsafeNewUnliftedArray Int
l
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ (\ !Int
i PrimArray a
pa -> forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> a -> m ()
writeUnliftedArray MutableUnliftedArray RealWorld (PrimArray a)
mla Int
i PrimArray a
pa forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
iforall a. Num a => a -> a -> a
+Int
1)) Int
0 [PrimArray a]
pas
(UnliftedArray BAArray# a
la#) <- forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
unsafeFreezeUnliftedArray MutableUnliftedArray RealWorld (PrimArray a)
mla
BAArray# a -> Int -> IO b
f (forall {k} (a :: k). BAArray# a -> BAArray# a
BAArray# BAArray# a
la#) Int
l
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) <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
!b
r <- MBA# a -> IO b
f (forall {k} (a :: k). MBA# a -> MBA# a
MBA# MBA# a
mba#)
!PrimArray a
pa <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
mpa
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray a
pa, b
r)
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 = forall a b. Prim a => PrimArray a -> (BA# a -> Int -> IO b) -> IO b
withPrimArrayUnsafe PrimArray a
arr 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
allocPrimVectorUnsafe :: forall a b. Prim a => Int
-> (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) <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
!b
r <- MBA# a -> IO b
f (forall {k} (a :: k). MBA# a -> MBA# a
MBA# MBA# a
mba#)
!PrimArray a
pa <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
mpa
let !v :: PrimVector a
v = forall a. PrimArray a -> Int -> Int -> PrimVector a
PrimVector PrimArray a
pa Int
0 Int
len
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimVector a
v, b
r)
allocBytesUnsafe :: Int
-> (MBA# Word8 -> IO b) -> IO (Bytes, b)
{-# INLINE allocBytesUnsafe #-}
allocBytesUnsafe :: forall b. Int -> (MBA# a -> IO b) -> IO (Bytes, b)
allocBytesUnsafe = forall a b.
Prim a =>
Int -> (MBA# a -> IO b) -> IO (PrimVector a, b)
allocPrimVectorUnsafe
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#) <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
1
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld a
mpa Int
0 a
v
!b
b <- MBA# a -> IO b
f (forall {k} (a :: k). MBA# a -> MBA# a
MBA# MBA# a
mba#)
!a
a <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray RealWorld a
mpa Int
0
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 :: 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#) <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
1
!b
b <- MBA# a -> IO b
f (forall {k} (a :: k). MBA# a -> MBA# a
MBA# MBA# a
mba#)
!a
a <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray RealWorld a
mpa Int
0
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)
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
| forall a. PrimArray a -> Bool
isPrimArrayPinned PrimArray a
arr = do
let siz :: Int
siz = forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
arr
forall a b. PrimArray a -> (Ptr a -> IO b) -> IO b
withPrimArrayContents PrimArray a
arr 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 = forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
arr
MutablePrimArray RealWorld a
buf <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
siz
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld a
buf Int
0 PrimArray a
arr Int
0 Int
siz
forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld a
buf forall a b. (a -> b) -> a -> b
$ \ Ptr a
ptr -> Ptr a -> Int -> IO b
f Ptr a
ptr Int
siz
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 = forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [PrimArray a]
pas0
MutablePrimArray RealWorld (Ptr a)
ptrs <- 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 <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld (Ptr a)
ptrs
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) =
forall a b. Prim a => PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
withPrimArraySafe PrimArray a
pa forall a b. (a -> b) -> a -> b
$ \ Ptr a
ppa Int
_ -> do
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld (Ptr a)
ptrs Int
i Ptr a
ppa
MutablePrimArray RealWorld (Ptr a) -> Int -> [PrimArray a] -> IO b
go MutablePrimArray RealWorld (Ptr a)
ptrs (Int
iforall a. Num a => a -> a -> a
+Int
1) [PrimArray a]
pas
allocPrimArraySafe :: forall a b . Prim a
=> Int
-> (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 <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newAlignedPinnedPrimArray Int
len
!b
r <- 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 <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
mpa
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray a
pa, b
r)
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
| forall a. PrimArray a -> Bool
isPrimArrayPinned PrimArray a
arr =
forall a b. PrimArray a -> (Ptr a -> IO b) -> IO b
withPrimArrayContents PrimArray a
arr forall a b. (a -> b) -> a -> b
$ \ Ptr a
ptr ->
let ptr' :: Ptr a
ptr' = Ptr a
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
s 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 <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
l
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld a
buf Int
0 PrimArray a
arr Int
s Int
l
forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld a
buf 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 = forall a. Prim a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)
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 <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newAlignedPinnedPrimArray Int
1
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld a
buf Int
0 a
v
!b
b <- forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld a
buf forall a b. (a -> b) -> a -> b
$ \ Ptr a
ptr -> Ptr a -> IO b
f Ptr a
ptr
!a
a <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray RealWorld a
buf Int
0
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)
{-# 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 <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newAlignedPinnedPrimArray Int
1
!b
b <- forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld a
buf forall a b. (a -> b) -> a -> b
$ \ Ptr a
ptr -> Ptr a -> IO b
f Ptr a
ptr
!a
a <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray RealWorld a
buf Int
0
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)
allocPrimVectorSafe :: forall a b . Prim a
=> Int
-> (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 <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newAlignedPinnedPrimArray Int
len
!b
r <- 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 <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
mpa
let !v :: PrimVector a
v = forall a. PrimArray a -> Int -> Int -> PrimVector a
PrimVector PrimArray a
pa Int
0 Int
len
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimVector a
v, b
r)
allocBytesSafe :: Int
-> (Ptr Word8 -> IO b) -> IO (Bytes, b)
{-# INLINABLE allocBytesSafe #-}
allocBytesSafe :: forall b. Int -> (Ptr Word8 -> IO b) -> IO (Bytes, b)
allocBytesSafe = forall a b.
Prim a =>
Int -> (Ptr a -> IO b) -> IO (PrimVector a, b)
allocPrimVectorSafe
pinPrimArray :: Prim a => PrimArray a -> IO (PrimArray a)
{-# INLINABLE pinPrimArray #-}
pinPrimArray :: forall a. Prim a => PrimArray a -> IO (PrimArray a)
pinPrimArray PrimArray a
arr
| forall a. PrimArray a -> Bool
isPrimArrayPinned PrimArray a
arr = forall (m :: * -> *) a. Monad m => a -> m a
return PrimArray a
arr
| Bool
otherwise = do
let l :: Int
l = forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
arr
MutablePrimArray RealWorld a
buf <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
l
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld a
buf Int
0 PrimArray a
arr Int
0 Int
l
PrimArray a
arr' <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
buf
forall (m :: * -> *) a. Monad m => a -> m a
return PrimArray a
arr'
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)
| forall a. PrimArray a -> Bool
isPrimArrayPinned PrimArray a
pa = forall (m :: * -> *) a. Monad m => a -> m a
return PrimVector a
v
| Bool
otherwise = do
MutablePrimArray RealWorld a
buf <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
l
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld a
buf Int
0 PrimArray a
pa Int
s Int
l
PrimArray a
pa' <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
buf
forall (m :: * -> *) a. Monad m => a -> m a
return (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 ()
clearPtr :: Ptr a -> Int -> IO ()
{-# INLINABLE clearPtr #-}
clearPtr :: forall a. Ptr a -> Int -> IO ()
clearPtr Ptr a
dest Int
nbytes = forall a. Ptr a -> CInt -> CSize -> IO ()
memset Ptr a
dest CInt
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nbytes)
fromNullTerminated :: Ptr a -> IO Bytes
{-# INLINABLE fromNullTerminated #-}
fromNullTerminated :: forall a. Ptr a -> IO Bytes
fromNullTerminated (Ptr Addr#
addr#) = do
Int
len <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Addr# -> IO CSize
c_strlen Addr#
addr#
MutablePrimArray RealWorld Word8
marr <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld Word8
marr Int
0 (forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
len
PrimArray Word8
arr <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
marr
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. PrimArray a -> Int -> Int -> PrimVector a
PrimVector PrimArray Word8
arr Int
0 Int
len)
fromPtr :: Ptr a -> Int
-> IO Bytes
{-# INLINABLE fromPtr #-}
fromPtr :: forall a. Ptr a -> Int -> IO Bytes
fromPtr (Ptr Addr#
addr#) Int
len = do
MutablePrimArray RealWorld Word8
marr <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld Word8
marr Int
0 (forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
len
PrimArray Word8
arr <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
marr
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. PrimArray a -> Int -> Int -> PrimVector a
PrimVector PrimArray Word8
arr Int
0 Int
len)
fromPrimPtr :: forall a. Prim a
=> Ptr a -> Int
-> 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 <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld a
marr Int
0 (forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
len
PrimArray a
arr <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
marr
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. PrimArray a -> Int -> Int -> PrimVector a
PrimVector PrimArray a
arr Int
0 Int
len)
data StdString
fromStdString :: IO (Ptr StdString) -> IO Bytes
{-# INLINABLE fromStdString #-}
fromStdString :: IO (Ptr StdString) -> IO Bytes
fromStdString IO (Ptr StdString)
f = 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,()
_) <- 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)
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 ()
fromByteString :: ByteString -> Bytes
{-# INLINABLE fromByteString #-}
fromByteString :: ByteString -> Bytes
fromByteString ByteString
bs = case ByteString -> ShortByteString
toShort ByteString
bs of
(SBS BA# a
ba#) -> forall a. PrimArray a -> Int -> Int -> PrimVector a
PrimVector (forall a. BA# a -> PrimArray a
PrimArray BA# a
ba#) Int
0 (ByteString -> Int
B.length ByteString
bs)
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.unsafeDrop Int
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
fromShort forall a b. (a -> b) -> a -> b
$ BA# a -> ShortByteString
SBS BA# a
ba#