Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
This module provides a pure linear interface for arrays with in-place mutation.
To use these mutable arrays, create a linear computation of type
Array a %1-> Ur b
and feed it to alloc
or fromList
.
A Tiny Example
>>>
:set -XLinearTypes
>>>
:set -XNoImplicitPrelude
>>>
import Prelude.Linear
>>>
import qualified Data.Array.Mutable.Linear as Array
>>>
:{
isFirstZero :: Array.Array Int %1-> Ur Bool isFirstZero arr = Array.get 0 arr & \(Ur val, arr') -> arr' `lseq` Ur (val == 0) :}
>>>
unur $ Array.fromList [0..10] isFirstZero
True>>>
unur $ Array.fromList [1,2,3] isFirstZero
False
Synopsis
- data Array a
- alloc :: HasCallStack => Int -> a -> (Array a %1 -> Ur b) %1 -> Ur b
- allocBeside :: Int -> a -> Array b %1 -> (Array a, Array b)
- fromList :: HasCallStack => [a] -> (Array a %1 -> Ur b) %1 -> Ur b
- set :: HasCallStack => Int -> a -> Array a %1 -> Array a
- unsafeSet :: Int -> a -> Array a %1 -> Array a
- resize :: HasCallStack => Int -> a -> Array a %1 -> Array a
- map :: (a -> b) -> Array a %1 -> Array b
- get :: HasCallStack => Int -> Array a %1 -> (Ur a, Array a)
- unsafeGet :: Int -> Array a %1 -> (Ur a, Array a)
- size :: Array a %1 -> (Ur Int, Array a)
- slice :: HasCallStack => Int -> Int -> Array a %1 -> (Array a, Array a)
- toList :: Array a %1 -> Ur [a]
- freeze :: Array a %1 -> Ur (Vector a)
- read :: HasCallStack => Array a %1 -> Int -> (Ur a, Array a)
- unsafeRead :: Array a %1 -> Int -> (Ur a, Array a)
- write :: HasCallStack => Array a %1 -> Int -> a -> Array a
- unsafeWrite :: Array a %1 -> Int -> a -> Array a
Mutable Linear Arrays
Performing Computations with Arrays
alloc :: HasCallStack => Int -> a -> (Array a %1 -> Ur b) %1 -> Ur b Source #
Allocate a constant array given a size and an initial value The size must be non-negative, otherwise this errors.
allocBeside :: Int -> a -> Array b %1 -> (Array a, Array b) Source #
Allocate a constant array given a size and an initial value, using another array as a uniqueness proof.
fromList :: HasCallStack => [a] -> (Array a %1 -> Ur b) %1 -> Ur b Source #
Allocate an array from a list
Modifications
set :: HasCallStack => Int -> a -> Array a %1 -> Array a Source #
Sets the value of an index. The index should be less than the arrays size, otherwise this errors.
unsafeSet :: Int -> a -> Array a %1 -> Array a Source #
Same as set
, but does not do bounds-checking. The behaviour is undefined
if an out-of-bounds index is provided.
resize :: HasCallStack => Int -> a -> Array a %1 -> Array a Source #
Resize an array. That is, given an array, a target size, and a seed value; resize the array to the given size using the seed value to fill in the new cells when necessary and copying over all the unchanged cells.
Target size should be non-negative.
let b = resize n x a, then size b = n, and b[i] = a[i] for i < size a, and b[i] = x for size a <= i < n.
Accessors
get :: HasCallStack => Int -> Array a %1 -> (Ur a, Array a) Source #
Get the value of an index. The index should be less than the arrays size
,
otherwise this errors.
unsafeGet :: Int -> Array a %1 -> (Ur a, Array a) Source #
Same as get
, but does not do bounds-checking. The behaviour is undefined
if an out-of-bounds index is provided.
Copy a slice of the array, starting from given offset and copying given number of elements. Returns the pair (oldArray, slice).
Start offset + target size should be within the input array, and both should be non-negative.
let b = slice i n a, then size b = n, and b[j] = a[i+j] for 0 <= j < n