primitive-0.8.0.0: Primitive memory-related operations
Copyright(c) Roman Leshchinskiy 2009-2012
LicenseBSD-style
MaintainerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Portabilitynon-portable
Safe HaskellSafe-Inferred
LanguageHaskell2010

Data.Primitive.PrimArray

Description

Arrays of unboxed primitive types. The functions provided by this module match the behavior of those provided by Data.Primitive.ByteArray, and the underlying types and primops that back them are the same. However, the type constructors PrimArray and MutablePrimArray take one additional argument compared to their respective counterparts ByteArray and MutableByteArray. This argument is used to designate the type of element in the array. Consequently, all functions in this module accept length and indices in terms of elements, not bytes.

Since: 0.6.4.0

Synopsis

Types

data PrimArray a Source #

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
Lift (PrimArray a :: Type) Source # 
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) #

Monoid (PrimArray a) Source #

Since: 0.6.4.0

Instance details

Defined in Data.Primitive.PrimArray

Semigroup (PrimArray a) Source #

Since: 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) Source #

Since: 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) Source #

Since: 0.6.4.0

Instance details

Defined in Data.Primitive.PrimArray

NFData (PrimArray a) Source # 
Instance details

Defined in Data.Primitive.PrimArray

Methods

rnf :: PrimArray a -> () #

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

Since: 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) Source #

Lexicographic ordering. Subject to change between major versions.

Since: 0.6.4.0

Instance details

Defined in Data.Primitive.PrimArray

type Item (PrimArray a) Source # 
Instance details

Defined in Data.Primitive.PrimArray

type Item (PrimArray a) = a

data MutablePrimArray s a Source #

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
NFData (MutablePrimArray s a) Source # 
Instance details

Defined in Data.Primitive.PrimArray

Methods

rnf :: MutablePrimArray s a -> () #

Eq (MutablePrimArray s a) Source # 
Instance details

Defined in Data.Primitive.PrimArray

Allocation

newPrimArray :: forall m a. (PrimMonad m, Prim a) => Int -> m (MutablePrimArray (PrimState m) a) Source #

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.

newPinnedPrimArray :: forall m a. (PrimMonad m, Prim a) => Int -> m (MutablePrimArray (PrimState m) a) Source #

Create a pinned primitive array of the specified size (in elements). The garbage collector is guaranteed not to move it.

Since: 0.7.1.0

newAlignedPinnedPrimArray :: forall m a. (PrimMonad m, Prim a) => Int -> m (MutablePrimArray (PrimState m) a) Source #

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.

Since: 0.7.0.0

resizeMutablePrimArray Source #

Arguments

:: forall m a. (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 Source #

Arguments

:: forall m a. (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.

Element Access

readPrimArray :: (Prim a, PrimMonad m) => MutablePrimArray (PrimState m) a -> Int -> m a Source #

Read a value from the array at the given index.

Note: this function does not do bounds checking.

writePrimArray Source #

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.

indexPrimArray :: forall a. Prim a => PrimArray a -> Int -> a Source #

Read a primitive value from the primitive array.

Note: this function does not do bounds checking.

Freezing and Thawing

freezePrimArray Source #

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 Source #

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: 0.7.2.0

runPrimArray :: (forall s. ST s (MutablePrimArray s a)) -> PrimArray a Source #

Execute the monadic action and freeze the resulting array.

runPrimArray m = runST $ m >>= unsafeFreezePrimArray

unsafeFreezePrimArray :: PrimMonad m => MutablePrimArray (PrimState m) a -> m (PrimArray a) Source #

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) Source #

Convert an immutable array to a mutable one without copying. The original array should not be used after the conversion.

Block Operations

copyPrimArray Source #

Arguments

:: forall m a. (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.

copyMutablePrimArray Source #

Arguments

:: forall m a. (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.

copyPrimArrayToPtr Source #

Arguments

:: forall m a. (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 Source #

Arguments

:: forall m a. (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 Source #

Arguments

:: forall m a. (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.

clonePrimArray Source #

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 Source #

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.

setPrimArray Source #

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.

Information

sameMutablePrimArray :: MutablePrimArray s a -> MutablePrimArray s a -> Bool Source #

Check if the two arrays refer to the same memory block.

getSizeofMutablePrimArray Source #

Arguments

:: forall m a. (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 Source #

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.

sizeofPrimArray :: forall a. Prim a => PrimArray a -> Int Source #

Get the size, in elements, of the primitive array.

primArrayContents :: PrimArray a -> Ptr a Source #

Yield a pointer to the array's data. This operation is only safe on pinned prim arrays allocated by newPinnedByteArray or newAlignedPinnedByteArray.

Since: 0.7.1.0

mutablePrimArrayContents :: MutablePrimArray s a -> Ptr a Source #

Yield a pointer to the array's data. This operation is only safe on pinned byte arrays allocated by newPinnedByteArray or newAlignedPinnedByteArray.

Since: 0.7.1.0

isPrimArrayPinned :: PrimArray a -> Bool Source #

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: 0.7.1.0

isMutablePrimArrayPinned :: MutablePrimArray s a -> Bool Source #

Check whether or not the mutable primitive array is pinned. This function is only available when compiling with GHC 8.2 or newer.

Since: 0.7.1.0

List Conversion

primArrayToList :: forall a. Prim a => PrimArray a -> [a] Source #

Convert a PrimArray to a list.

primArrayFromList :: Prim a => [a] -> PrimArray a Source #

Create a PrimArray from a list.

primArrayFromList vs = primArrayFromListN (length vs) vs

primArrayFromListN :: forall a. Prim a => Int -> [a] -> PrimArray a Source #

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.

Folding

foldrPrimArray :: forall a b. Prim a => (a -> b -> b) -> b -> PrimArray a -> b Source #

Lazy right-associated fold over the elements of a PrimArray.

foldrPrimArray' :: forall a b. Prim a => (a -> b -> b) -> b -> PrimArray a -> b Source #

Strict right-associated fold over the elements of a PrimArray.

foldlPrimArray :: forall a b. Prim a => (b -> a -> b) -> b -> PrimArray a -> b Source #

Lazy left-associated fold over the elements of a PrimArray.

foldlPrimArray' :: forall a b. Prim a => (b -> a -> b) -> b -> PrimArray a -> b Source #

Strict left-associated fold over the elements of a PrimArray.

foldlPrimArrayM' :: (Prim a, Monad m) => (b -> a -> m b) -> b -> PrimArray a -> m b Source #

Strict left-associated fold over the elements of a PrimArray.

Effectful Folding

traversePrimArray_ :: (Applicative f, Prim a) => (a -> f b) -> PrimArray a -> f () Source #

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 () Source #

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.

Map/Create

mapPrimArray :: (Prim a, Prim b) => (a -> b) -> PrimArray a -> PrimArray b Source #

Map over the elements of a primitive array.

imapPrimArray :: (Prim a, Prim b) => (Int -> a -> b) -> PrimArray a -> PrimArray b Source #

Indexed map over the elements of a primitive array.

generatePrimArray Source #

Arguments

:: Prim a 
=> Int

length

-> (Int -> a)

element from index

-> PrimArray a 

Generate a primitive array.

replicatePrimArray Source #

Arguments

:: Prim a 
=> Int

length

-> a

element

-> PrimArray a 

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

filterPrimArray :: Prim a => (a -> Bool) -> PrimArray a -> PrimArray a Source #

Filter elements of a primitive array according to a predicate.

mapMaybePrimArray :: (Prim a, Prim b) => (a -> Maybe b) -> PrimArray a -> PrimArray b Source #

Map over a primitive array, optionally discarding some elements. This has the same behavior as Data.Maybe.mapMaybe.

Effectful Map/Create

The naming conventions adopted in this section are explained in the documentation of the Data.Primitive module.

Lazy Applicative

traversePrimArray Source #

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) Source #

Traverse a primitive array with the index of each element.

generatePrimArrayA Source #

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 Source #

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.

filterPrimArrayA Source #

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 Source #

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.

Strict Primitive Monadic

traversePrimArrayP :: (PrimMonad m, Prim a, Prim b) => (a -> m b) -> PrimArray a -> m (PrimArray b) Source #

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.

itraversePrimArrayP :: (Prim a, Prim b, PrimMonad m) => (Int -> a -> m b) -> PrimArray a -> m (PrimArray b) Source #

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.

generatePrimArrayP Source #

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) Source #

Execute the monadic action the given number of times and store the results in a primitive array.

filterPrimArrayP :: (PrimMonad m, Prim a) => (a -> m Bool) -> PrimArray a -> m (PrimArray a) Source #

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) Source #

Map over the primitive array, keeping the elements for which the monadic predicate provides a Just.