Z-Data-2.0.1.0: Array, vector and text
Copyright(c) Dong Han 2017-2018
LicenseBSD
Maintainer[email protected]
Stabilityexperimental
Portabilitynon-portable
Safe HaskellSafe-Inferred
LanguageHaskell2010

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 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 Arraypinnedunpinned
unsafedirectly passdirectly pass
safedirectly passmake 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

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 #

Arguments

:: forall a b. Prim a 
=> Int

number of elements

-> (MBA# a -> IO b) 
-> IO (PrimVector a, b) 

Allocate a prim array and pass to FFI as pointer, freeze result into a PrimVector.

USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.

allocBytesUnsafe Source #

Arguments

:: Int

number of bytes

-> (MBA# Word8 -> IO b) 
-> IO (Bytes, b) 

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.

allocPrimArraySafe Source #

Arguments

:: forall a b. Prim a 
=> Int

in elements

-> (Ptr a -> IO b) 
-> IO (PrimArray a, b) 

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.

allocPrimVectorSafe Source #

Arguments

:: forall a b. Prim a 
=> Int

in elements

-> (Ptr a -> IO b) 
-> IO (PrimVector a, b) 

Allocate a prim array and pass to FFI as pointer, freeze result into a PrimVector.

allocBytesSafe Source #

Arguments

:: Int

in bytes

-> (Ptr Word8 -> IO b) 
-> IO (Bytes, b) 

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

clearMBA Source #

Arguments

:: MBA# a 
-> Int

in bytes

-> IO () 

Clear MBA# with given length to zero.

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.

castPtr :: Ptr a -> Ptr b #

The castPtr function casts a pointer from one type to another.

fromNullTerminated :: Ptr a -> IO Bytes Source #

Copy some bytes from a null terminated pointer(without copying the null terminator).

You should consider using 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.

fromPtr Source #

Arguments

:: Ptr a 
-> Int

in bytes

-> IO Bytes 

Copy some bytes from a pointer.

There's no encoding guarantee, result could be any bytes sequence.

fromPrimPtr Source #

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.

data StdString Source #

std::string Pointer tag.

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

re-export

data RealWorld #

RealWorld is deeply magical. It is primitive, but it is not unlifted (hence ptrArg). We never manipulate values of type RealWorld; it's only used in the type system, to parameterise State#.

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.

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.

Instances

Instances details
PrimUnlifted (MutablePrimArray s a) Source # 
Instance details

Defined in Z.Data.Array.UnliftedArray

NFData (MutablePrimArray s a) 
Instance details

Defined in Data.Primitive.PrimArray

Methods

rnf :: MutablePrimArray s a -> () #

Eq (MutablePrimArray s a) 
Instance details

Defined in Data.Primitive.PrimArray

data PrimArray a #

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

Instances details
Prim a => Arr PrimArray a Source # 
Instance details

Defined in Z.Data.Array.Base

Associated Types

type MArr PrimArray = (mar :: Type -> Type -> Type) Source #

Methods

emptyArr :: PrimArray a Source #

newArr :: (PrimMonad m, PrimState m ~ s) => Int -> m (MArr PrimArray s a) Source #

newArrWith :: (PrimMonad m, PrimState m ~ s) => Int -> a -> m (MArr PrimArray s a) Source #

readArr :: (PrimMonad m, PrimState m ~ s) => MArr PrimArray s a -> Int -> m a Source #

writeArr :: (PrimMonad m, PrimState m ~ s) => MArr PrimArray s a -> Int -> a -> m () Source #

setArr :: (PrimMonad m, PrimState m ~ s) => MArr PrimArray s a -> Int -> Int -> a -> m () Source #

indexArr :: PrimArray a -> Int -> a Source #

indexArr' :: PrimArray a -> Int -> (# a #) Source #

indexArrM :: Monad m => PrimArray a -> Int -> m a Source #

freezeArr :: (PrimMonad m, PrimState m ~ s) => MArr PrimArray s a -> Int -> Int -> m (PrimArray a) Source #

thawArr :: (PrimMonad m, PrimState m ~ s) => PrimArray a -> Int -> Int -> m (MArr PrimArray s a) Source #

unsafeFreezeArr :: (PrimMonad m, PrimState m ~ s) => MArr PrimArray s a -> m (PrimArray a) Source #

unsafeThawArr :: (PrimMonad m, PrimState m ~ s) => PrimArray a -> m (MArr PrimArray s a) Source #

copyArr :: (PrimMonad m, PrimState m ~ s) => MArr PrimArray s a -> Int -> PrimArray a -> Int -> Int -> m () Source #

copyMutableArr :: (PrimMonad m, PrimState m ~ s) => MArr PrimArray s a -> Int -> MArr PrimArray s a -> Int -> Int -> m () Source #

moveArr :: (PrimMonad m, PrimState m ~ s) => MArr PrimArray s a -> Int -> MArr PrimArray s a -> Int -> Int -> m () Source #

cloneArr :: PrimArray a -> Int -> Int -> PrimArray a Source #

cloneMutableArr :: (PrimMonad m, PrimState m ~ s) => MArr PrimArray s a -> Int -> Int -> m (MArr PrimArray s a) Source #

resizeMutableArr :: (PrimMonad m, PrimState m ~ s) => MArr PrimArray s a -> Int -> m (MArr PrimArray s a) Source #

shrinkMutableArr :: (PrimMonad m, PrimState m ~ s) => MArr PrimArray s a -> Int -> m () Source #

sameMutableArr :: MArr PrimArray s a -> MArr PrimArray s a -> Bool Source #

sizeofArr :: PrimArray a -> Int Source #

sizeofMutableArr :: (PrimMonad m, PrimState m ~ s) => MArr PrimArray s a -> m Int Source #

sameArr :: PrimArray a -> PrimArray a -> Bool Source #

Prim a => Vec PrimArray a Source # 
Instance details

Defined in Z.Data.Vector.Base

Associated Types

type IArray PrimArray :: Type -> Type Source #

Lift (PrimArray a :: Type) 
Instance details

Defined in Data.Primitive.PrimArray

Methods

lift :: Quote m => PrimArray a -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => PrimArray a -> Code m (PrimArray a) #

PrimUnlifted (PrimArray a) Source # 
Instance details

Defined in Z.Data.Array.UnliftedArray

(Prim a, JSON a) => JSON (PrimArray a) Source # 
Instance details

Defined in Z.Data.JSON.Base

(Prim a, Print a) => Print (PrimArray a) Source # 
Instance details

Defined in Z.Data.Text.Print

Monoid (PrimArray a)

Since: primitive-0.6.4.0

Instance details

Defined in Data.Primitive.PrimArray

Semigroup (PrimArray a)

Since: primitive-0.6.4.0

Instance details

Defined in Data.Primitive.PrimArray

Methods

(<>) :: PrimArray a -> PrimArray a -> PrimArray a #

sconcat :: NonEmpty (PrimArray a) -> PrimArray a #

stimes :: Integral b => b -> PrimArray a -> PrimArray a #

Prim a => IsList (PrimArray a)

Since: primitive-0.6.4.0

Instance details

Defined in Data.Primitive.PrimArray

Associated Types

type Item (PrimArray a) #

Methods

fromList :: [Item (PrimArray a)] -> PrimArray a #

fromListN :: Int -> [Item (PrimArray a)] -> PrimArray a #

toList :: PrimArray a -> [Item (PrimArray a)] #

(Show a, Prim a) => Show (PrimArray a)

Since: primitive-0.6.4.0

Instance details

Defined in Data.Primitive.PrimArray

NFData (PrimArray a) 
Instance details

Defined in Data.Primitive.PrimArray

Methods

rnf :: PrimArray a -> () #

(Eq a, Prim a) => Eq (PrimArray a)

Since: primitive-0.6.4.0

Instance details

Defined in Data.Primitive.PrimArray

Methods

(==) :: PrimArray a -> PrimArray a -> Bool #

(/=) :: PrimArray a -> PrimArray a -> Bool #

(Ord a, Prim a) => Ord (PrimArray a)

Lexicographic ordering. Subject to change between major versions.

Since: primitive-0.6.4.0

Instance details

Defined in Data.Primitive.PrimArray

type MArr PrimArray Source # 
Instance details

Defined in Z.Data.Array.Base

type IArray PrimArray Source # 
Instance details

Defined in Z.Data.Vector.Base

type Item (PrimArray a) 
Instance details

Defined in Data.Primitive.PrimArray

type Item (PrimArray a) = a

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.

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.

resizeMutablePrimArray #

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.

shrinkMutablePrimArray #

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.

writePrimArray #

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.

copyMutablePrimArray #

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.

copyPrimArray #

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.

copyPrimArrayToPtr #

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.

copyMutablePrimArrayToPtr #

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.

copyPtrToMutablePrimArray #

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.

setPrimArray #

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.

getSizeofMutablePrimArray #

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.

freezePrimArray #

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.

thawPrimArray #

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.

generatePrimArrayP #

Arguments

:: (PrimMonad m, Prim a) 
=> Int

length

-> (Int -> m a)

generator

-> m (PrimArray a) 

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.

filterPrimArrayA #

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.

mapMaybePrimArrayA #

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.

traversePrimArray #

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.

generatePrimArray #

Arguments

:: Prim a 
=> Int

length

-> (Int -> a)

element from index

-> PrimArray a 

Generate a primitive array.

replicatePrimArray #

Arguments

:: Prim a 
=> Int

length

-> a

element

-> PrimArray a 

Create a primitive array by copying the element the given number of times.

generatePrimArrayA #

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.

replicatePrimArrayA #

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

clonePrimArray #

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.

cloneMutablePrimArray #

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

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.

Internal helpers