Copyright | (c) Dong Han 2017-2018 |
---|---|
License | BSD |
Maintainer | [email protected] |
Stability | experimental |
Portability | non-portable |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Z.Foreign
Description
This module provide functions for using PrimArray
and PrimVector
with GHC FFI(Foreign function interface),
Some functions are designed to be used with 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 arraysunpinned
. 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 calledpinned
. Allocating these arrays are bit more expensive since it's more like howmalloc
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 forsafe
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 bothpinned
andunpinned
arrays in this case. The use case forunsafe
FFIs are short/small functions, which can be treated like a fat primitive operations, such asmemcpy
,memcmp
. Usingunsafe
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.
Synopsis
- withPrimArrayUnsafe :: Prim a => PrimArray a -> (BA# a -> Int -> IO b) -> IO b
- allocPrimArrayUnsafe :: forall a b. Prim a => Int -> (MBA# a -> IO b) -> IO (PrimArray a, b)
- withPrimVectorUnsafe :: Prim a => PrimVector a -> (BA# a -> Int -> Int -> IO b) -> IO b
- allocPrimVectorUnsafe :: forall a b. Prim a => Int -> (MBA# a -> IO b) -> IO (PrimVector a, b)
- allocBytesUnsafe :: Int -> (MBA# Word8 -> IO b) -> IO (Bytes, b)
- withPrimUnsafe :: Prim a => a -> (MBA# a -> IO b) -> IO (a, b)
- allocPrimUnsafe :: Prim a => (MBA# a -> IO b) -> IO (a, b)
- withPrimArrayListUnsafe :: [PrimArray a] -> (BAArray# a -> Int -> IO b) -> IO b
- withPrimArraySafe :: Prim a => PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
- allocPrimArraySafe :: forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO (PrimArray a, b)
- withPrimVectorSafe :: forall a b. Prim a => PrimVector a -> (Ptr a -> Int -> IO b) -> IO b
- allocPrimVectorSafe :: forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO (PrimVector a, b)
- allocBytesSafe :: Int -> (Ptr Word8 -> IO b) -> IO (Bytes, b)
- withPrimSafe :: forall a b. Prim a => a -> (Ptr a -> IO b) -> IO (a, b)
- allocPrimSafe :: forall a b. Prim a => (Ptr a -> IO b) -> IO (a, b)
- withPrimArrayListSafe :: Prim a => [PrimArray a] -> (Ptr (Ptr a) -> Int -> IO b) -> IO b
- pinPrimArray :: Prim a => PrimArray a -> IO (PrimArray a)
- pinPrimVector :: Prim a => PrimVector a -> IO (PrimVector a)
- type BA# a = ByteArray#
- type MBA# a = MutableByteArray# RealWorld
- type BAArray# a = ArrayArray#
- clearMBA :: MBA# a -> Int -> IO ()
- clearPtr :: Ptr a -> Int -> IO ()
- castPtr :: Ptr a -> Ptr b
- fromNullTerminated :: Ptr a -> IO Bytes
- fromPtr :: Ptr a -> Int -> IO Bytes
- fromPrimPtr :: forall a. Prim a => Ptr a -> Int -> IO (PrimVector a)
- data StdString
- fromStdString :: IO (Ptr StdString) -> IO Bytes
- fromByteString :: ByteString -> Bytes
- toByteString :: Bytes -> ByteString
- data RealWorld
- touch :: PrimMonad m => a -> m ()
- module Data.Primitive.ByteArray
- data MutablePrimArray s a = MutablePrimArray (MutableByteArray# s)
- data PrimArray a = PrimArray ByteArray#
- primArrayFromList :: Prim a => [a] -> PrimArray a
- primArrayFromListN :: Prim a => Int -> [a] -> PrimArray a
- primArrayToList :: Prim a => PrimArray a -> [a]
- emptyPrimArray :: PrimArray a
- newPrimArray :: (PrimMonad m, Prim a) => Int -> m (MutablePrimArray (PrimState m) a)
- resizeMutablePrimArray :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> m (MutablePrimArray (PrimState m) a)
- shrinkMutablePrimArray :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> m ()
- readPrimArray :: (Prim a, PrimMonad m) => MutablePrimArray (PrimState m) a -> Int -> m a
- writePrimArray :: (Prim a, PrimMonad m) => MutablePrimArray (PrimState m) a -> Int -> a -> m ()
- copyMutablePrimArray :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
- copyPrimArray :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> PrimArray a -> Int -> Int -> m ()
- copyPrimArrayToPtr :: (PrimMonad m, Prim a) => Ptr a -> PrimArray a -> Int -> Int -> m ()
- copyMutablePrimArrayToPtr :: (PrimMonad m, Prim a) => Ptr a -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
- copyPtrToMutablePrimArray :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
- setPrimArray :: (Prim a, PrimMonad m) => MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
- getSizeofMutablePrimArray :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> m Int
- sizeofMutablePrimArray :: forall s a. Prim a => MutablePrimArray s a -> Int
- sameMutablePrimArray :: MutablePrimArray s a -> MutablePrimArray s a -> Bool
- freezePrimArray :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> Int -> m (PrimArray a)
- thawPrimArray :: (PrimMonad m, Prim a) => PrimArray a -> Int -> Int -> m (MutablePrimArray (PrimState m) a)
- unsafeFreezePrimArray :: PrimMonad m => MutablePrimArray (PrimState m) a -> m (PrimArray a)
- unsafeThawPrimArray :: PrimMonad m => PrimArray a -> m (MutablePrimArray (PrimState m) a)
- indexPrimArray :: Prim a => PrimArray a -> Int -> a
- sizeofPrimArray :: Prim a => PrimArray a -> Int
- isPrimArrayPinned :: PrimArray a -> Bool
- isMutablePrimArrayPinned :: MutablePrimArray s a -> Bool
- foldrPrimArray :: Prim a => (a -> b -> b) -> b -> PrimArray a -> b
- foldrPrimArray' :: Prim a => (a -> b -> b) -> b -> PrimArray a -> b
- foldlPrimArray :: Prim a => (b -> a -> b) -> b -> PrimArray a -> b
- foldlPrimArray' :: Prim a => (b -> a -> b) -> b -> PrimArray a -> b
- foldlPrimArrayM' :: (Prim a, Monad m) => (b -> a -> m b) -> b -> PrimArray a -> m b
- traversePrimArrayP :: (PrimMonad m, Prim a, Prim b) => (a -> m b) -> PrimArray a -> m (PrimArray b)
- filterPrimArrayP :: (PrimMonad m, Prim a) => (a -> m Bool) -> PrimArray a -> m (PrimArray a)
- mapMaybePrimArrayP :: (PrimMonad m, Prim a, Prim b) => (a -> m (Maybe b)) -> PrimArray a -> m (PrimArray b)
- generatePrimArrayP :: (PrimMonad m, Prim a) => Int -> (Int -> m a) -> m (PrimArray a)
- replicatePrimArrayP :: (PrimMonad m, Prim a) => Int -> m a -> m (PrimArray a)
- mapPrimArray :: (Prim a, Prim b) => (a -> b) -> PrimArray a -> PrimArray b
- imapPrimArray :: (Prim a, Prim b) => (Int -> a -> b) -> PrimArray a -> PrimArray b
- filterPrimArray :: Prim a => (a -> Bool) -> PrimArray a -> PrimArray a
- filterPrimArrayA :: (Applicative f, Prim a) => (a -> f Bool) -> PrimArray a -> f (PrimArray a)
- mapMaybePrimArrayA :: (Applicative f, Prim a, Prim b) => (a -> f (Maybe b)) -> PrimArray a -> f (PrimArray b)
- mapMaybePrimArray :: (Prim a, Prim b) => (a -> Maybe b) -> PrimArray a -> PrimArray b
- traversePrimArray :: (Applicative f, Prim a, Prim b) => (a -> f b) -> PrimArray a -> f (PrimArray b)
- itraversePrimArray :: (Applicative f, Prim a, Prim b) => (Int -> a -> f b) -> PrimArray a -> f (PrimArray b)
- itraversePrimArrayP :: (Prim a, Prim b, PrimMonad m) => (Int -> a -> m b) -> PrimArray a -> m (PrimArray b)
- generatePrimArray :: Prim a => Int -> (Int -> a) -> PrimArray a
- replicatePrimArray :: Prim a => Int -> a -> PrimArray a
- generatePrimArrayA :: (Applicative f, Prim a) => Int -> (Int -> f a) -> f (PrimArray a)
- replicatePrimArrayA :: (Applicative f, Prim a) => Int -> f a -> f (PrimArray a)
- traversePrimArray_ :: (Applicative f, Prim a) => (a -> f b) -> PrimArray a -> f ()
- itraversePrimArray_ :: (Applicative f, Prim a) => (Int -> a -> f b) -> PrimArray a -> f ()
- newPinnedPrimArray :: (PrimMonad m, Prim a) => Int -> m (MutablePrimArray (PrimState m) a)
- newAlignedPinnedPrimArray :: (PrimMonad m, Prim a) => Int -> m (MutablePrimArray (PrimState m) a)
- primArrayContents :: PrimArray a -> Ptr a
- mutablePrimArrayContents :: MutablePrimArray s a -> Ptr a
- clonePrimArray :: Prim a => PrimArray a -> Int -> Int -> PrimArray a
- cloneMutablePrimArray :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> Int -> m (MutablePrimArray (PrimState m) a)
- runPrimArray :: (forall s. ST s (MutablePrimArray s a)) -> PrimArray a
- module Foreign.C.Types
- module Data.Primitive.Ptr
- module Z.Data.Array.Unaligned
- withMutablePrimArrayContents :: MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
- withPrimArrayContents :: PrimArray a -> (Ptr a -> IO b) -> IO b
- hs_std_string_size :: Ptr StdString -> IO Int
- hs_copy_std_string :: Ptr StdString -> Int -> MBA# Word8 -> IO ()
- hs_delete_std_string :: Ptr StdString -> IO ()
Unsafe FFI
withPrimArrayUnsafe :: Prim a => PrimArray a -> (BA# a -> Int -> IO b) -> IO b Source #
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.
allocPrimArrayUnsafe :: forall a b. Prim a => Int -> (MBA# a -> IO b) -> IO (PrimArray a, b) Source #
Allocate some bytes and pass to FFI as pointer, freeze result into a PrimArray
.
USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
withPrimVectorUnsafe :: Prim a => PrimVector a -> (BA# a -> Int -> Int -> IO b) -> IO b Source #
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.
allocPrimVectorUnsafe Source #
Allocate a prim array and pass to FFI as pointer, freeze result into a PrimVector
.
USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
Allocate some bytes and pass to FFI as pointer, freeze result into a Bytes
.
USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
withPrimUnsafe :: Prim a => a -> (MBA# a -> IO b) -> IO (a, b) Source #
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.
allocPrimUnsafe :: Prim a => (MBA# a -> IO b) -> IO (a, b) Source #
like withPrimUnsafe
, but don't write initial value.
USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
withPrimArrayListUnsafe :: [PrimArray a] -> (BAArray# a -> Int -> IO b) -> IO b Source #
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.
Safe FFI
withPrimArraySafe :: Prim a => PrimArray a -> (Ptr a -> Int -> IO b) -> IO b Source #
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 #14346.
Allocate a prim array and pass to FFI as pointer, freeze result into a PrimVector
.
withPrimVectorSafe :: forall a b. Prim a => PrimVector a -> (Ptr a -> Int -> IO b) -> IO b Source #
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 #14346.
Allocate a prim array and pass to FFI as pointer, freeze result into a PrimVector
.
Allocate some bytes and pass to FFI as pointer, freeze result into a PrimVector
.
withPrimSafe :: forall a b. Prim a => a -> (Ptr a -> IO b) -> IO (a, b) Source #
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 #14346.
allocPrimSafe :: forall a b. Prim a => (Ptr a -> IO b) -> IO (a, b) Source #
like withPrimSafe
, but don't write initial value.
withPrimArrayListSafe :: Prim a => [PrimArray a] -> (Ptr (Ptr a) -> Int -> IO b) -> IO b Source #
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 #14346.
pinPrimArray :: Prim a => PrimArray a -> IO (PrimArray a) Source #
Convert a PrimArray
to a pinned one(memory won't moved by GC) if necessary.
pinPrimVector :: Prim a => PrimVector a -> IO (PrimVector a) Source #
Convert a PrimVector
to a pinned one(memory won't moved by GC) if necessary.
Pointer helpers
type BA# a = ByteArray# Source #
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:
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 MBA# a = MutableByteArray# RealWorld Source #
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:
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 BAArray# a = ArrayArray# Source #
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
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
clearPtr :: Ptr a -> Int -> IO () Source #
Zero a structure.
There's no Storable
or Prim
constraint on a
type, the length
should be given in bytes.
Copy some bytes from a pointer.
There's no encoding guarantee, result could be any bytes sequence.
Arguments
:: forall a. Prim a | |
=> Ptr a | |
-> Int | in elements |
-> IO (PrimVector a) |
Copy some bytes from a pointer.
There's no encoding guarantee, result could be any bytes sequence.
fromStdString :: IO (Ptr StdString) -> IO Bytes Source #
Run FFI in bracket and marshall std::string*
result into Haskell heap bytes,
memory pointed by std::string*
will be delete
ed.
convert between bytestring
fromByteString :: ByteString -> Bytes Source #
O(n), Convert from ByteString
.
toByteString :: Bytes -> ByteString Source #
O(n), Convert tp ByteString
.
re-export
touch :: PrimMonad m => a -> m () #
Ensure that the value is considered alive by the garbage collection.
Warning: GHC has optimization passes that can erase touch
if it is
certain that an exception is thrown afterward. Prefer keepAlive
.
module Data.Primitive.ByteArray
data MutablePrimArray s a #
Mutable primitive arrays associated with a primitive state token.
These can be written to and read from in a monadic context that supports
sequencing, such as IO
or ST
. Typically, a mutable primitive array will
be built and then converted to an immutable primitive array using
unsafeFreezePrimArray
. However, it is also acceptable to simply discard
a mutable primitive array since it lives in managed memory and will be
garbage collected when no longer referenced.
Constructors
MutablePrimArray (MutableByteArray# s) |
Instances
PrimUnlifted (MutablePrimArray s a) Source # | |
Defined in Z.Data.Array.UnliftedArray Methods writeUnliftedArray# :: MutableArrayArray# s0 -> Int# -> MutablePrimArray s a -> State# s0 -> State# s0 Source # readUnliftedArray# :: MutableArrayArray# s0 -> Int# -> State# s0 -> (# State# s0, MutablePrimArray s a #) Source # indexUnliftedArray# :: ArrayArray# -> Int# -> MutablePrimArray s a Source # | |
NFData (MutablePrimArray s a) | |
Defined in Data.Primitive.PrimArray Methods rnf :: MutablePrimArray s a -> () # | |
Eq (MutablePrimArray s a) | |
Defined in Data.Primitive.PrimArray Methods (==) :: MutablePrimArray s a -> MutablePrimArray s a -> Bool # (/=) :: MutablePrimArray s a -> MutablePrimArray s a -> Bool # |
Arrays of unboxed elements. This accepts types like Double
, Char
,
Int
and Word
, as well as their fixed-length variants (Word8
,
Word16
, etc.). Since the elements are unboxed, a PrimArray
is strict
in its elements. This differs from the behavior of Array
,
which is lazy in its elements.
Constructors
PrimArray ByteArray# |
Instances
primArrayFromList :: Prim a => [a] -> PrimArray a #
Create a PrimArray
from a list.
primArrayFromList vs = primArrayFromListN
(length vs) vs
primArrayFromListN :: Prim a => Int -> [a] -> PrimArray a #
Create a PrimArray
from a list of a known length. If the length
of the list does not match the given length, this throws an exception.
primArrayToList :: Prim a => PrimArray a -> [a] #
Convert a PrimArray
to a list.
emptyPrimArray :: PrimArray a #
The empty PrimArray
.
newPrimArray :: (PrimMonad m, Prim a) => Int -> m (MutablePrimArray (PrimState m) a) #
Create a new mutable primitive array of the given length. The underlying memory is left uninitialized.
Note: this function does not check if the input is non-negative.
Arguments
:: (PrimMonad m, Prim a) | |
=> MutablePrimArray (PrimState m) a | |
-> Int | new size |
-> m (MutablePrimArray (PrimState m) a) |
Resize a mutable primitive array. The new size is given in elements.
This will either resize the array in-place or, if not possible, allocate the contents into a new, unpinned array and copy the original array's contents.
To avoid undefined behaviour, the original MutablePrimArray
shall not be
accessed anymore after a resizeMutablePrimArray
has been performed.
Moreover, no reference to the old one should be kept in order to allow
garbage collection of the original MutablePrimArray
in case a new
MutablePrimArray
had to be allocated.
Arguments
:: (PrimMonad m, Prim a) | |
=> MutablePrimArray (PrimState m) a | |
-> Int | new size |
-> m () |
Shrink a mutable primitive array. The new size is given in elements. It must be smaller than the old size. The array will be resized in place.
readPrimArray :: (Prim a, PrimMonad m) => MutablePrimArray (PrimState m) a -> Int -> m a #
Read a value from the array at the given index.
Note: this function does not do bounds checking.
Arguments
:: (Prim a, PrimMonad m) | |
=> MutablePrimArray (PrimState m) a | array |
-> Int | index |
-> a | element |
-> m () |
Write an element to the given index.
Note: this function does not do bounds checking.
Arguments
:: (PrimMonad m, Prim a) | |
=> MutablePrimArray (PrimState m) a | destination array |
-> Int | offset into destination array |
-> MutablePrimArray (PrimState m) a | source array |
-> Int | offset into source array |
-> Int | number of elements to copy |
-> m () |
Copy part of a mutable array into another mutable array. In the case that the destination and source arrays are the same, the regions may overlap.
Note: this function does not do bounds or overlap checking.
Arguments
:: (PrimMonad m, Prim a) | |
=> MutablePrimArray (PrimState m) a | destination array |
-> Int | offset into destination array |
-> PrimArray a | source array |
-> Int | offset into source array |
-> Int | number of elements to copy |
-> m () |
Copy part of an array into another mutable array.
Note: this function does not do bounds or overlap checking.
Arguments
:: (PrimMonad m, Prim a) | |
=> Ptr a | destination pointer |
-> PrimArray a | source array |
-> Int | offset into source array |
-> Int | number of elements to copy |
-> m () |
Copy a slice of an immutable primitive array to a pointer.
The offset and length are given in elements of type a
.
This function assumes that the Prim
instance of a
agrees with the Storable
instance.
Note: this function does not do bounds or overlap checking.
Arguments
:: (PrimMonad m, Prim a) | |
=> Ptr a | destination pointer |
-> MutablePrimArray (PrimState m) a | source array |
-> Int | offset into source array |
-> Int | number of elements to copy |
-> m () |
Copy a slice of a mutable primitive array to a pointer.
The offset and length are given in elements of type a
.
This function assumes that the Prim
instance of a
agrees with the Storable
instance.
Note: this function does not do bounds or overlap checking.
Arguments
:: (PrimMonad m, Prim a) | |
=> MutablePrimArray (PrimState m) a | destination array |
-> Int | destination offset |
-> Ptr a | source pointer |
-> Int | number of elements |
-> m () |
Copy from a pointer to a mutable primitive array.
The offset and length are given in elements of type a
.
This function assumes that the Prim
instance of a
agrees with the Storable
instance.
Note: this function does not do bounds or overlap checking.
Arguments
:: (Prim a, PrimMonad m) | |
=> MutablePrimArray (PrimState m) a | array to fill |
-> Int | offset into array |
-> Int | number of values to fill |
-> a | value to fill with |
-> m () |
Fill a slice of a mutable primitive array with a value.
Note: this function does not do bounds checking.
Arguments
:: (PrimMonad m, Prim a) | |
=> MutablePrimArray (PrimState m) a | array |
-> m Int |
Get the size of a mutable primitive array in elements. Unlike sizeofMutablePrimArray
,
this function ensures sequencing in the presence of resizing.
sizeofMutablePrimArray :: forall s a. Prim a => MutablePrimArray s a -> Int #
Size of the mutable primitive array in elements. This function shall not
be used on primitive arrays that are an argument to or a result of
resizeMutablePrimArray
or shrinkMutablePrimArray
.
This function is deprecated and will be removed.
sameMutablePrimArray :: MutablePrimArray s a -> MutablePrimArray s a -> Bool #
Check if the two arrays refer to the same memory block.
Arguments
:: (PrimMonad m, Prim a) | |
=> MutablePrimArray (PrimState m) a | source |
-> Int | offset in elements |
-> Int | length in elements |
-> m (PrimArray a) |
Create an immutable copy of a slice of a primitive array. The offset and length are given in elements.
This operation makes a copy of the specified section, so it is safe to continue using the mutable array afterward.
Note: The provided array should contain the full subrange specified by the two Ints, but this is not checked.
Arguments
:: (PrimMonad m, Prim a) | |
=> PrimArray a | source |
-> Int | offset in elements |
-> Int | length in elements |
-> m (MutablePrimArray (PrimState m) a) |
Create a mutable primitive array from a slice of an immutable primitive array. The offset and length are given in elements.
This operation makes a copy of the specified slice, so it is safe to use the immutable array afterward.
Note: The provided array should contain the full subrange specified by the two Ints, but this is not checked.
Since: primitive-0.7.2.0
unsafeFreezePrimArray :: PrimMonad m => MutablePrimArray (PrimState m) a -> m (PrimArray a) #
Convert a mutable primitive array to an immutable one without copying. The array should not be modified after the conversion.
unsafeThawPrimArray :: PrimMonad m => PrimArray a -> m (MutablePrimArray (PrimState m) a) #
Convert an immutable array to a mutable one without copying. The original array should not be used after the conversion.
indexPrimArray :: Prim a => PrimArray a -> Int -> a #
Read a primitive value from the primitive array.
Note: this function does not do bounds checking.
sizeofPrimArray :: Prim a => PrimArray a -> Int #
Get the size, in elements, of the primitive array.
isPrimArrayPinned :: PrimArray a -> Bool #
Check whether or not the primitive array is pinned. Pinned primitive arrays cannot
be moved by the garbage collector. It is safe to use primArrayContents
on such arrays. This function is only available when compiling with
GHC 8.2 or newer.
Since: primitive-0.7.1.0
isMutablePrimArrayPinned :: MutablePrimArray s a -> Bool #
Check whether or not the mutable primitive array is pinned. This function is only available when compiling with GHC 8.2 or newer.
Since: primitive-0.7.1.0
foldrPrimArray :: Prim a => (a -> b -> b) -> b -> PrimArray a -> b #
Lazy right-associated fold over the elements of a PrimArray
.
foldrPrimArray' :: Prim a => (a -> b -> b) -> b -> PrimArray a -> b #
Strict right-associated fold over the elements of a PrimArray
.
foldlPrimArray :: Prim a => (b -> a -> b) -> b -> PrimArray a -> b #
Lazy left-associated fold over the elements of a PrimArray
.
foldlPrimArray' :: Prim a => (b -> a -> b) -> b -> PrimArray a -> b #
Strict left-associated fold over the elements of a PrimArray
.
foldlPrimArrayM' :: (Prim a, Monad m) => (b -> a -> m b) -> b -> PrimArray a -> m b #
Strict left-associated fold over the elements of a PrimArray
.
traversePrimArrayP :: (PrimMonad m, Prim a, Prim b) => (a -> m b) -> PrimArray a -> m (PrimArray b) #
Traverse a primitive array. The traversal forces the resulting values and writes them to the new primitive array as it performs the monadic effects. Consequently:
>>>
traversePrimArrayP (\x -> print x $> bool x undefined (x == 2)) (fromList [1, 2, 3 :: Int])
1 2 *** Exception: Prelude.undefined
In many situations, traversePrimArrayP
can replace traversePrimArray
,
changing the strictness characteristics of the traversal but typically improving
the performance. Consider the following short-circuiting traversal:
incrPositiveA :: PrimArray Int -> Maybe (PrimArray Int) incrPositiveA xs = traversePrimArray (\x -> bool Nothing (Just (x + 1)) (x > 0)) xs
This can be rewritten using traversePrimArrayP
. To do this, we must
change the traversal context to MaybeT (ST s)
, which has a PrimMonad
instance:
incrPositiveB :: PrimArray Int -> Maybe (PrimArray Int) incrPositiveB xs = runST $ runMaybeT $ traversePrimArrayP (\x -> bool (MaybeT (return Nothing)) (MaybeT (return (Just (x + 1)))) (x > 0)) xs
Benchmarks demonstrate that the second implementation runs 150 times faster than the first. It also results in fewer allocations.
filterPrimArrayP :: (PrimMonad m, Prim a) => (a -> m Bool) -> PrimArray a -> m (PrimArray a) #
Filter the primitive array, keeping the elements for which the monadic predicate evaluates to true.
mapMaybePrimArrayP :: (PrimMonad m, Prim a, Prim b) => (a -> m (Maybe b)) -> PrimArray a -> m (PrimArray b) #
Map over the primitive array, keeping the elements for which the monadic
predicate provides a Just
.
Generate a primitive array by evaluating the monadic generator function at each index.
replicatePrimArrayP :: (PrimMonad m, Prim a) => Int -> m a -> m (PrimArray a) #
Execute the monadic action the given number of times and store the results in a primitive array.
mapPrimArray :: (Prim a, Prim b) => (a -> b) -> PrimArray a -> PrimArray b #
Map over the elements of a primitive array.
imapPrimArray :: (Prim a, Prim b) => (Int -> a -> b) -> PrimArray a -> PrimArray b #
Indexed map over the elements of a primitive array.
filterPrimArray :: Prim a => (a -> Bool) -> PrimArray a -> PrimArray a #
Filter elements of a primitive array according to a predicate.
Arguments
:: (Applicative f, Prim a) | |
=> (a -> f Bool) | mapping function |
-> PrimArray a | primitive array |
-> f (PrimArray a) |
Filter the primitive array, keeping the elements for which the monadic predicate evaluates true.
Arguments
:: (Applicative f, Prim a, Prim b) | |
=> (a -> f (Maybe b)) | mapping function |
-> PrimArray a | primitive array |
-> f (PrimArray b) |
Map over the primitive array, keeping the elements for which the applicative
predicate provides a Just
.
mapMaybePrimArray :: (Prim a, Prim b) => (a -> Maybe b) -> PrimArray a -> PrimArray b #
Map over a primitive array, optionally discarding some elements. This
has the same behavior as Data.Maybe.mapMaybe
.
Arguments
:: (Applicative f, Prim a, Prim b) | |
=> (a -> f b) | mapping function |
-> PrimArray a | primitive array |
-> f (PrimArray b) |
Traverse a primitive array. The traversal performs all of the applicative effects before forcing the resulting values and writing them to the new primitive array. Consequently:
>>>
traversePrimArray (\x -> print x $> bool x undefined (x == 2)) (fromList [1, 2, 3 :: Int])
1 2 3 *** Exception: Prelude.undefined
The function traversePrimArrayP
always outperforms this function, but it
requires a PrimMonad
constraint, and it forces the values as
it performs the effects.
itraversePrimArray :: (Applicative f, Prim a, Prim b) => (Int -> a -> f b) -> PrimArray a -> f (PrimArray b) #
Traverse a primitive array with the index of each element.
itraversePrimArrayP :: (Prim a, Prim b, PrimMonad m) => (Int -> a -> m b) -> PrimArray a -> m (PrimArray b) #
Traverse a primitive array with the indices. The traversal forces the resulting values and writes them to the new primitive array as it performs the monadic effects.
Generate a primitive array.
Create a primitive array by copying the element the given number of times.
Arguments
:: (Applicative f, Prim a) | |
=> Int | length |
-> (Int -> f a) | element from index |
-> f (PrimArray a) |
Generate a primitive array by evaluating the applicative generator function at each index.
Arguments
:: (Applicative f, Prim a) | |
=> Int | length |
-> f a | applicative element producer |
-> f (PrimArray a) |
Execute the applicative action the given number of times and store the
results in a PrimArray
.
traversePrimArray_ :: (Applicative f, Prim a) => (a -> f b) -> PrimArray a -> f () #
Traverse the primitive array, discarding the results. There
is no PrimMonad
variant of this function, since it would not provide
any performance benefit.
itraversePrimArray_ :: (Applicative f, Prim a) => (Int -> a -> f b) -> PrimArray a -> f () #
Traverse the primitive array with the indices, discarding the results.
There is no PrimMonad
variant of this function, since it would not
provide any performance benefit.
newPinnedPrimArray :: (PrimMonad m, Prim a) => Int -> m (MutablePrimArray (PrimState m) a) #
Create a pinned primitive array of the specified size (in elements). The garbage collector is guaranteed not to move it. The underlying memory is left uninitialized.
Since: primitive-0.7.1.0
newAlignedPinnedPrimArray :: (PrimMonad m, Prim a) => Int -> m (MutablePrimArray (PrimState m) a) #
Create a pinned primitive array of the specified size (in elements) and
with the alignment given by its Prim
instance. The garbage collector is
guaranteed not to move it. The underlying memory is left uninitialized.
Since: primitive-0.7.0.0
primArrayContents :: PrimArray a -> Ptr a #
Yield a pointer to the array's data. This operation is only safe on
pinned prim arrays allocated by newPinnedByteArray
or
newAlignedPinnedByteArray
.
Since: primitive-0.7.1.0
mutablePrimArrayContents :: MutablePrimArray s a -> Ptr a #
Yield a pointer to the array's data. This operation is only safe on
pinned byte arrays allocated by newPinnedByteArray
or
newAlignedPinnedByteArray
.
Since: primitive-0.7.1.0
Arguments
:: Prim a | |
=> PrimArray a | source array |
-> Int | offset into destination array |
-> Int | number of elements to copy |
-> PrimArray a |
Return a newly allocated array with the specified subrange of the provided array. The provided array should contain the full subrange specified by the two Ints, but this is not checked.
Arguments
:: (PrimMonad m, Prim a) | |
=> MutablePrimArray (PrimState m) a | source array |
-> Int | offset into destination array |
-> Int | number of elements to copy |
-> m (MutablePrimArray (PrimState m) a) |
Return a newly allocated mutable array with the specified subrange of the provided mutable array. The provided mutable array should contain the full subrange specified by the two Ints, but this is not checked.
runPrimArray :: (forall s. ST s (MutablePrimArray s a)) -> PrimArray a #
Execute the monadic action and freeze the resulting array.
runPrimArray m = runST $ m >>= unsafeFreezePrimArray
module Foreign.C.Types
module Data.Primitive.Ptr
module Z.Data.Array.Unaligned
withMutablePrimArrayContents :: MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b Source #
Obtain the pointer to the content of an mutable array, and the pointer should only be used during the IO action.
This operation is only safe on pinned primitive arrays (Arrays allocated by newPinnedPrimArray
or
newAlignedPinnedPrimArray
).
Don't pass a forever loop to this function, see #14346.
withPrimArrayContents :: PrimArray a -> (Ptr a -> IO b) -> IO b Source #
Obtain the pointer to the content of an array, and the pointer should only be used during the IO action.
This operation is only safe on pinned primitive arrays (Arrays allocated by newPinnedPrimArray
or
newAlignedPinnedPrimArray
).
Don't pass a forever loop to this function, see #14346.