accelerate-0.15.0.0: An embedded language for accelerated array processing

Copyright[2008..2014] Manuel M T Chakravarty, Gabriele Keller [2008..2009] Sean Lee [2009..2014] Trevor L. McDonell [2013..2014] Robert Clifton-Everest
LicenseBSD3
MaintainerManuel M T Chakravarty <chak@cse.unsw.edu.au>
Stabilityexperimental
Portabilitynon-portable (GHC extensions)
Safe HaskellNone
LanguageHaskell98

Data.Array.Accelerate

Contents

Description

This module defines an embedded language of array computations for high-performance computing. Computations on multi-dimensional, regular arrays are expressed in the form of parameterised collective operations (such as maps, reductions, and permutations). These computations are online compiled and executed on a range of architectures.

Abstract interface:

The types representing array computations are only exported abstractly — i.e., client code can generate array computations and submit them for execution, but it cannot inspect these computations. This is to allow for more flexibility for future extensions of this library.

Code execution:

Access to the various backends is via a run function in backend-specific top level modules. Currently, we have the following:

Examples and documentation:

Synopsis

The Accelerate Array Language

Array data types

data Acc a Source

Array-valued collective computations

Instances

Lift Acc (Acc a) 
(Arrays a, Arrays b) => Unlift Acc (Acc a, Acc b) 
(Lift Acc a, Lift Acc b, Arrays (Plain a), Arrays (Plain b)) => Lift Acc (a, b) 
(Shape sh, Elt e) => Lift Acc (Array sh e) 
(Arrays a, Arrays b, Arrays c) => Unlift Acc (Acc a, Acc b, Acc c) 
(Lift Acc a, Lift Acc b, Lift Acc c, Arrays (Plain a), Arrays (Plain b), Arrays (Plain c)) => Lift Acc (a, b, c) 
(Arrays a, Arrays b, Arrays c, Arrays d) => Unlift Acc (Acc a, Acc b, Acc c, Acc d) 
(Lift Acc a, Lift Acc b, Lift Acc c, Lift Acc d, Arrays (Plain a), Arrays (Plain b), Arrays (Plain c), Arrays (Plain d)) => Lift Acc (a, b, c, d) 
(Arrays a, Arrays b, Arrays c, Arrays d, Arrays e) => Unlift Acc (Acc a, Acc b, Acc c, Acc d, Acc e) 
(Lift Acc a, Lift Acc b, Lift Acc c, Lift Acc d, Lift Acc e, Arrays (Plain a), Arrays (Plain b), Arrays (Plain c), Arrays (Plain d), Arrays (Plain e)) => Lift Acc (a, b, c, d, e) 
(Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f) => Unlift Acc (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f) 
(Lift Acc a, Lift Acc b, Lift Acc c, Lift Acc d, Lift Acc e, Lift Acc f, Arrays (Plain a), Arrays (Plain b), Arrays (Plain c), Arrays (Plain d), Arrays (Plain e), Arrays (Plain f)) => Lift Acc (a, b, c, d, e, f) 
(Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g) => Unlift Acc (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g) 
(Lift Acc a, Lift Acc b, Lift Acc c, Lift Acc d, Lift Acc e, Lift Acc f, Lift Acc g, Arrays (Plain a), Arrays (Plain b), Arrays (Plain c), Arrays (Plain d), Arrays (Plain e), Arrays (Plain f), Arrays (Plain g)) => Lift Acc (a, b, c, d, e, f, g) 
(Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h) => Unlift Acc (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h) 
(Lift Acc a, Lift Acc b, Lift Acc c, Lift Acc d, Lift Acc e, Lift Acc f, Lift Acc g, Lift Acc h, Arrays (Plain a), Arrays (Plain b), Arrays (Plain c), Arrays (Plain d), Arrays (Plain e), Arrays (Plain f), Arrays (Plain g), Arrays (Plain h)) => Lift Acc (a, b, c, d, e, f, g, h) 
(Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i) => Unlift Acc (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i) 
(Lift Acc a, Lift Acc b, Lift Acc c, Lift Acc d, Lift Acc e, Lift Acc f, Lift Acc g, Lift Acc h, Lift Acc i, Arrays (Plain a), Arrays (Plain b), Arrays (Plain c), Arrays (Plain d), Arrays (Plain e), Arrays (Plain f), Arrays (Plain g), Arrays (Plain h), Arrays (Plain i)) => Lift Acc (a, b, c, d, e, f, g, h, i) 
Arrays arrs => Show (Acc arrs) 
Afunction (Acc a -> f) => Show (Acc a -> f) 
Typeable (* -> *) Acc 
type Plain (Acc a) = a 

class (Typeable (ArrRepr a), Typeable (ArrRepr' a), Typeable a) => Arrays a Source

Minimal complete definition

arrays, arrays', toArr, toArr', fromArr, fromArr'

Instances

Arrays () 
(Arrays b, Arrays a) => Arrays (b, a) 
(Shape sh, Elt e) => Arrays (Array sh e) 
(Arrays c, Arrays b, Arrays a) => Arrays (c, b, a) 
(Arrays d, Arrays c, Arrays b, Arrays a) => Arrays (d, c, b, a) 
(Arrays e, Arrays d, Arrays c, Arrays b, Arrays a) => Arrays (e, d, c, b, a) 
(Arrays f, Arrays e, Arrays d, Arrays c, Arrays b, Arrays a) => Arrays (f, e, d, c, b, a) 
(Arrays g, Arrays f, Arrays e, Arrays d, Arrays c, Arrays b, Arrays a) => Arrays (g, f, e, d, c, b, a) 
(Arrays h, Arrays g, Arrays f, Arrays e, Arrays d, Arrays c, Arrays b, Arrays a) => Arrays (h, g, f, e, d, c, b, a) 
(Arrays i, Arrays h, Arrays g, Arrays f, Arrays e, Arrays d, Arrays c, Arrays b, Arrays a) => Arrays (i, h, g, f, e, d, c, b, a) 

data Array sh e Source

Multi-dimensional arrays for array processing.

If device and host memory are separate, arrays will be transferred to the device when necessary (if possible asynchronously and in parallel with other tasks) and cached on the device if sufficient memory is available.

Instances

(Shape sh, Elt e) => Lift Acc (Array sh e) 
Elt e => IsList (Vector e) 
Show (Array sh e) 
(Shape sh, Elt e) => Arrays (Array sh e) 
Typeable (* -> * -> *) Array 
type Item (Vector e) = e 
type Plain (Array sh e) = Array sh e 

type Scalar e = Array DIM0 e Source

Scalars arrays hold a single element

type Vector e = Array DIM1 e Source

Vectors are one-dimensional arrays

type Segments i = Vector i Source

Segment descriptor (vector of segment lengths).

To represent nested one-dimensional arrays, we use a flat array of data values in conjunction with a segment descriptor, which stores the lengths of the subarrays.

Array element types

class (Show a, Typeable a, Typeable (EltRepr a), Typeable (EltRepr' a), ArrayElt (EltRepr a), ArrayElt (EltRepr' a)) => Elt a Source

Accelerate supports as array elements only simple atomic types, and tuples thereof. These element types are stored efficiently in memory, unpacked as consecutive elements without pointers.

This class characterises the types of values that can be array elements, and hence, appear in scalar Accelerate expressions.

Minimal complete definition

eltType, fromElt, toElt, eltType', fromElt', toElt'

Instances

Elt Bool 
Elt Char 
Elt Double 
Elt Float 
Elt Int 
Elt Int8 
Elt Int16 
Elt Int32 
Elt Int64 
Elt Word 
Elt Word8 
Elt Word16 
Elt Word32 
Elt Word64 
Elt () 
Elt CChar 
Elt CSChar 
Elt CUChar 
Elt CShort 
Elt CUShort 
Elt CInt 
Elt CUInt 
Elt CLong 
Elt CULong 
Elt CLLong 
Elt CULLong 
Elt CFloat 
Elt CDouble 
Elt All 
Elt Z 
Elt a => Elt (Complex a) 
Shape sh => Elt (Any ((:.) sh Int)) 
Elt (Any Z) 
(Elt a, Elt b) => Elt (a, b) 
(Elt t, Elt h) => Elt ((:.) t h) 
(Elt a, Elt b, Elt c) => Elt (a, b, c) 
(Elt a, Elt b, Elt c, Elt d) => Elt (a, b, c, d) 
(Elt a, Elt b, Elt c, Elt d, Elt e) => Elt (a, b, c, d, e) 
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) => Elt (a, b, c, d, e, f) 
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g) => Elt (a, b, c, d, e, f, g) 
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h) => Elt (a, b, c, d, e, f, g, h) 
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i) => Elt (a, b, c, d, e, f, g, h, i) 

Shapes & Indices

Array indices are snoc type lists; that is, they are backwards and the end-of-list token, Z, occurs on the left. For example, the type of a rank-2 array index is Z :. Int :. Int.

data Z Source

Rank-0 index

Constructors

Z 

Instances

Eq Z 
Show Z 
Slice Z 
Shape Z 
Elt Z 
Typeable * Z 
Unlift Exp Z 
Lift Exp Z 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) 
Elt e => IsList (Vector e) 
Elt (Any Z) 
type SliceShape Z = Z 
type CoSliceShape Z = Z 
type FullShape Z = Z 
type Plain Z = Z 
type Item (Vector e) = e 

data tail :. head infixl 3 Source

Increase an index rank by one dimension. The :. operator is used to construct both values and types.

Constructors

tail :. head infixl 3 

Instances

Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) 
(Elt e, Slice (Plain ix), Unlift Exp ix) => Unlift Exp ((:.) ix (Exp e)) 
(Elt e, Slice ix) => Unlift Exp ((:.) (Exp ix) (Exp e)) 
(Elt e, Slice (Plain ix), Lift Exp ix) => Lift Exp ((:.) ix (Exp e)) 
(Slice (Plain ix), Lift Exp ix) => Lift Exp ((:.) ix All) 
(Slice (Plain ix), Lift Exp ix) => Lift Exp ((:.) ix Int) 
Elt e => IsList (Vector e) 
Shape sh => Elt (Any ((:.) sh Int)) 
(Eq tail, Eq head) => Eq ((:.) tail head) 
(Show tail, Show head) => Show ((:.) tail head) 
Slice sl => Slice ((:.) sl Int) 
Slice sl => Slice ((:.) sl All) 
Shape sh => Shape ((:.) sh Int) 
(Elt t, Elt h) => Elt ((:.) t h) 
Typeable (* -> * -> *) (:.) 
(Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row0) => Stencil ((:.) ((:.) sh Int) Int) a (row2, row1, row0) 
(Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row3, Stencil ((:.) sh Int) a row4, Stencil ((:.) sh Int) a row5) => Stencil ((:.) ((:.) sh Int) Int) a (row1, row2, row3, row4, row5) 
(Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row3, Stencil ((:.) sh Int) a row4, Stencil ((:.) sh Int) a row5, Stencil ((:.) sh Int) a row6, Stencil ((:.) sh Int) a row7) => Stencil ((:.) ((:.) sh Int) Int) a (row1, row2, row3, row4, row5, row6, row7) 
(Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row3, Stencil ((:.) sh Int) a row4, Stencil ((:.) sh Int) a row5, Stencil ((:.) sh Int) a row6, Stencil ((:.) sh Int) a row7, Stencil ((:.) sh Int) a row8, Stencil ((:.) sh Int) a row9) => Stencil ((:.) ((:.) sh Int) Int) a (row1, row2, row3, row4, row5, row6, row7, row8, row9) 
type Item (Vector e) = e 
type SliceShape ((:.) sl Int) = SliceShape sl 
type SliceShape ((:.) sl All) = (:.) (SliceShape sl) Int 
type CoSliceShape ((:.) sl Int) = (:.) (CoSliceShape sl) Int 
type CoSliceShape ((:.) sl All) = CoSliceShape sl 
type FullShape ((:.) sl Int) = (:.) (FullShape sl) Int 
type FullShape ((:.) sl All) = (:.) (FullShape sl) Int 
type Plain ((:.) ix (Exp e)) = (:.) (Plain ix) e 
type Plain ((:.) ix All) = (:.) (Plain ix) All 
type Plain ((:.) ix Int) = (:.) (Plain ix) Int 

class (Elt sh, Elt (Any sh), Shape (EltRepr sh)) => Shape sh Source

Shapes and indices of multi-dimensional arrays

Minimal complete definition

sliceAnyIndex

Instances

Shape Z 
Shape sh => Shape ((:.) sh Int) 

data All Source

Marker for entire dimensions in slice descriptors.

For example, when used in slices passed to replicate, the occurrences of All indicate the dimensions into which the array's existing extent will be placed, rather than the new dimensions introduced by replication.

Constructors

All 

Instances

Eq All 
Show All 
Elt All 
Typeable * All 
(Slice (Plain ix), Lift Exp ix) => Lift Exp ((:.) ix All) 
Slice sl => Slice ((:.) sl All) 
type SliceShape ((:.) sl All) = (:.) (SliceShape sl) Int 
type CoSliceShape ((:.) sl All) = CoSliceShape sl 
type FullShape ((:.) sl All) = (:.) (FullShape sl) Int 
type Plain ((:.) ix All) = (:.) (Plain ix) All 

data Any sh Source

Marker for arbitrary shapes in slice descriptors. Such arbitrary shapes may include an unknown number of dimensions.

Any can be used in the leftmost position of a slice instead of Z, for example (Any :. _ :. _). In the following definition Any is used to match against whatever shape the type variable sh takes:

repN :: (Shape sh, Elt e) => Int -> Acc (Array sh e) -> Acc (Array (sh:.Int) e)
repN n a = replicate (constant $ Any :. n) a

Constructors

Any 

Instances

Shape sh => Lift Exp (Any sh) 
Eq (Any sh) 
Show (Any sh) 
Shape sh => Slice (Any sh) 
Shape sh => Elt (Any ((:.) sh Int)) 
Elt (Any Z) 
Typeable (* -> *) Any 
type SliceShape (Any sh) = sh 
type CoSliceShape (Any sh) = Z 
type FullShape (Any sh) = sh 
type Plain (Any sh) = Any sh 

class (Elt sl, Shape (SliceShape sl), Shape (CoSliceShape sl), Shape (FullShape sl)) => Slice sl where Source

Slices, aka generalised indices, as n-tuples and mappings of slice indices to slices, co-slices, and slice dimensions

Associated Types

type SliceShape sl :: * Source

type CoSliceShape sl :: * Source

type FullShape sl :: * Source

Methods

sliceIndex :: sl -> SliceIndex (EltRepr sl) (EltRepr (SliceShape sl)) (EltRepr (CoSliceShape sl)) (EltRepr (FullShape sl)) Source

Instances

Slice Z 
Shape sh => Slice (Any sh) 
Slice sl => Slice ((:.) sl Int) 
Slice sl => Slice ((:.) sl All) 

type DIM0 = Z Source

Accessors

Indexing

(!) :: (Shape ix, Elt e) => Acc (Array ix e) -> Exp ix -> Exp e infixl 9 Source

Expression form that extracts a scalar from an array

(!!) :: (Shape ix, Elt e) => Acc (Array ix e) -> Exp Int -> Exp e infixl 9 Source

Expression form that extracts a scalar from an array at a linear index

the :: Elt e => Acc (Scalar e) -> Exp e Source

Extraction of the element in a singleton array

Shape information

null :: (Shape ix, Elt e) => Acc (Array ix e) -> Exp Bool Source

Test whether an array is empty

length :: Elt e => Acc (Vector e) -> Exp Int Source

Get the length of a vector

shape :: (Shape ix, Elt e) => Acc (Array ix e) -> Exp ix Source

Expression form that yields the shape of an array

size :: (Shape ix, Elt e) => Acc (Array ix e) -> Exp Int Source

Expression form that yields the size of an array

shapeSize :: Shape ix => Exp ix -> Exp Int Source

The total number of elements in an array of the given Shape

Extracting sub-arrays

slice :: (Slice slix, Elt e) => Acc (Array (FullShape slix) e) -> Exp slix -> Acc (Array (SliceShape slix) e) Source

Index an array with a generalised array index, supplied as the second argument. The result is a new array (possibly a singleton) containing the selected dimensions (Alls) in their entirety.

This can be used to cut out entire dimensions. The opposite of replicate. For example, if mat is a two dimensional array, the following will select a specific row and yield a one dimensional result:

slice mat (lift (Z :. (2::Int) :. All))

A fully specified index (with no Alls) would return a single element (zero dimensional array).

init :: Elt e => Acc (Vector e) -> Acc (Vector e) Source

Yield all but the last element of the input vector. The vector must not be empty.

tail :: Elt e => Acc (Vector e) -> Acc (Vector e) Source

Yield all but the first element of the input vector. The vector must not be empty.

take :: Elt e => Exp Int -> Acc (Vector e) -> Acc (Vector e) Source

Yield the first n elements of the input vector. The vector must contain no more than n elements.

drop :: Elt e => Exp Int -> Acc (Vector e) -> Acc (Vector e) Source

Yield all but the first n elements of the input vector. The vector must contain no fewer than n elements.

slit :: Elt e => Exp Int -> Exp Int -> Acc (Vector e) -> Acc (Vector e) Source

Yield a slit (slice) from the vector. The vector must contain at least i + n elements. Denotationally, we have:

slit i n = take n . drop i

Construction

Introduction

use :: Arrays arrays => arrays -> Acc arrays Source

Array inlet: makes an array available for processing using the Accelerate language.

Depending upon the backend used to execute array computations, this may trigger (asynchronous) data transfer.

unit :: Elt e => Exp e -> Acc (Scalar e) Source

Scalar inlet: injects a scalar (or a tuple of scalars) into a singleton array for use in the Accelerate language.

Initialisation

generate :: (Shape ix, Elt a) => Exp ix -> (Exp ix -> Exp a) -> Acc (Array ix a) Source

Construct a new array by applying a function to each index.

For example, the following will generate a one-dimensional array (Vector) of three floating point numbers:

generate (index1 3) (\_ -> 1.2)

Or, equivalently:

generate (constant (Z :. (3::Int))) (\_ -> 1.2)

Finally, the following will create an array equivalent to '[1..10]':

generate (index1 10) $ \ ix ->
         let (Z :. i) = unlift ix
         in fromIntegral i
NOTE:

Using generate, it is possible to introduce nested data parallelism, which will cause the program to fail.

If the index given by the scalar function is then used to dispatch further parallel work, whose result is returned into Exp terms by array indexing operations such as (!) or the, the program will fail with the error: './Data/Array/Accelerate/Trafo/Sharing.hs:447 (convertSharingExp): inconsistent valuation @ shared 'Exp' tree ...'.

replicate :: (Slice slix, Elt e) => Exp slix -> Acc (Array (SliceShape slix) e) -> Acc (Array (FullShape slix) e) Source

Replicate an array across one or more dimensions as specified by the generalised array index provided as the first argument.

For example, assuming arr is a vector (one-dimensional array),

replicate (lift (Z :. (2::Int) :. All :. (3::Int))) arr

yields a three dimensional array, where arr is replicated twice across the first and three times across the third dimension.

fill :: (Shape sh, Elt e) => Exp sh -> Exp e -> Acc (Array sh e) Source

Create an array where all elements are the same value.

Enumeration

enumFromN :: (Shape sh, Elt e, IsNum e) => Exp sh -> Exp e -> Acc (Array sh e) Source

Create an array of the given shape containing the values x, x+1, etc (in row-major order).

enumFromStepN Source

Arguments

:: (Shape sh, Elt e, IsNum e) 
=> Exp sh 
-> Exp e

x: start

-> Exp e

y: step

-> Acc (Array sh e) 

Create an array of the given shape containing the values x, x+y, x+y+y etc. (in row-major order).

Concatenation

(++) :: forall sh e. (Slice sh, Shape sh, Elt e) => Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e) infixr 5 Source

Concatenate outermost component of two arrays. The extent of the lower dimensional component is the intersection of the two arrays.

Composition

Flow control

(?|) :: Arrays a => Exp Bool -> (Acc a, Acc a) -> Acc a infix 0 Source

Infix version of acond. If the predicate evaluates to True, the first component of the tuple is returned, else the second.

acond Source

Arguments

:: Arrays a 
=> Exp Bool

if-condition

-> Acc a

then-array

-> Acc a

else-array

-> Acc a 

An array-level if-then-else construct.

awhile :: Arrays a => (Acc a -> Acc (Scalar Bool)) -> (Acc a -> Acc a) -> Acc a -> Acc a Source

An array-level while construct

Pipelining

(>->) :: (Arrays a, Arrays b, Arrays c) => (Acc a -> Acc b) -> (Acc b -> Acc c) -> Acc a -> Acc c infixl 1 Source

Pipelining of two array computations.

Denotationally, we have

(acc1 >-> acc2) arrs = let tmp = acc1 arrs in acc2 tmp

Modifying Arrays

Shape manipulation

reshape :: (Shape ix, Shape ix', Elt e) => Exp ix -> Acc (Array ix' e) -> Acc (Array ix e) Source

Change the shape of an array without altering its contents. The size of the source and result arrays must be identical.

precondition: size ix == size ix'

flatten :: (Shape ix, Elt a) => Acc (Array ix a) -> Acc (Vector a) Source

Flattens a given array of arbitrary dimension.

Permutations

permute Source

Arguments

:: (Shape ix, Shape ix', Elt a) 
=> (Exp a -> Exp a -> Exp a)

combination function

-> Acc (Array ix' a)

array of default values

-> (Exp ix -> Exp ix')

permutation

-> Acc (Array ix a)

array to be permuted

-> Acc (Array ix' a) 

Forward permutation specified by an index mapping. The result array is initialised with the given defaults and any further values that are permuted into the result array are added to the current value using the given combination function.

The combination function must be associative and commutative. Elements that are mapped to the magic value ignore by the permutation function are dropped.

backpermute Source

Arguments

:: (Shape ix, Shape ix', Elt a) 
=> Exp ix'

shape of the result array

-> (Exp ix' -> Exp ix)

permutation

-> Acc (Array ix a)

source array

-> Acc (Array ix' a) 

Backward permutation specified by an index mapping from the destination array specifying which element of the source array to read.

ignore :: Shape ix => Exp ix Source

Magic value identifying elements that are ignored in a forward permutation. Note that this currently does not work for singleton arrays.

Specialised permutations

reverse :: Elt e => Acc (Vector e) -> Acc (Vector e) Source

Reverse the elements of a vector.

transpose :: Elt e => Acc (Array DIM2 e) -> Acc (Array DIM2 e) Source

Transpose the rows and columns of a matrix.

Element-wise operations

Mapping

map :: (Shape ix, Elt a, Elt b) => (Exp a -> Exp b) -> Acc (Array ix a) -> Acc (Array ix b) Source

Apply the given function element-wise to the given array.

Zipping

zipWith :: (Shape ix, Elt a, Elt b, Elt c) => (Exp a -> Exp b -> Exp c) -> Acc (Array ix a) -> Acc (Array ix b) -> Acc (Array ix c) Source

Apply the given binary function element-wise to the two arrays. The extent of the resulting array is the intersection of the extents of the two source arrays.

zipWith3 :: (Shape sh, Elt a, Elt b, Elt c, Elt d) => (Exp a -> Exp b -> Exp c -> Exp d) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) Source

Zip three arrays with the given function, analogous to zipWith.

zipWith4 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) Source

Zip four arrays with the given function, analogous to zipWith.

zipWith5 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) Source

Zip five arrays with the given function, analogous to zipWith.

zipWith6 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) Source

Zip six arrays with the given function, analogous to zipWith.

zipWith7 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh h) Source

Zip seven arrays with the given function, analogous to zipWith.

zipWith8 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h -> Exp i) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh h) -> Acc (Array sh i) Source

Zip eight arrays with the given function, analogous to zipWith.

zipWith9 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h -> Exp i -> Exp j) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh h) -> Acc (Array sh i) -> Acc (Array sh j) Source

Zip nine arrays with the given function, analogous to zipWith.

zip :: (Shape sh, Elt a, Elt b) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh (a, b)) Source

Combine the elements of two arrays pairwise. The shape of the result is the intersection of the two argument shapes.

zip3 :: (Shape sh, Elt a, Elt b, Elt c) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh (a, b, c)) Source

Take three arrays and return an array of triples, analogous to zip.

zip4 :: (Shape sh, Elt a, Elt b, Elt c, Elt d) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh (a, b, c, d)) Source

Take four arrays and return an array of quadruples, analogous to zip.

zip5 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh (a, b, c, d, e)) Source

Take five arrays and return an array of five-tuples, analogous to zip.

zip6 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh (a, b, c, d, e, f)) Source

Take six arrays and return an array of six-tuples, analogous to zip.

zip7 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh (a, b, c, d, e, f, g)) Source

Take seven arrays and return an array of seven-tuples, analogous to zip.

zip8 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh h) -> Acc (Array sh (a, b, c, d, e, f, g, h)) Source

Take seven arrays and return an array of seven-tuples, analogous to zip.

zip9 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh h) -> Acc (Array sh i) -> Acc (Array sh (a, b, c, d, e, f, g, h, i)) Source

Take seven arrays and return an array of seven-tuples, analogous to zip.

Unzipping

unzip :: (Shape sh, Elt a, Elt b) => Acc (Array sh (a, b)) -> (Acc (Array sh a), Acc (Array sh b)) Source

The converse of zip, but the shape of the two results is identical to the shape of the argument.

unzip3 :: (Shape sh, Elt a, Elt b, Elt c) => Acc (Array sh (a, b, c)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c)) Source

Take an array of triples and return three arrays, analogous to unzip.

unzip4 :: (Shape sh, Elt a, Elt b, Elt c, Elt d) => Acc (Array sh (a, b, c, d)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d)) Source

Take an array of quadruples and return four arrays, analogous to unzip.

unzip5 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e) => Acc (Array sh (a, b, c, d, e)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d), Acc (Array sh e)) Source

Take an array of 5-tuples and return five arrays, analogous to unzip.

unzip6 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) => Acc (Array sh (a, b, c, d, e, f)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d), Acc (Array sh e), Acc (Array sh f)) Source

Take an array of 6-tuples and return six arrays, analogous to unzip.

unzip7 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g) => Acc (Array sh (a, b, c, d, e, f, g)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d), Acc (Array sh e), Acc (Array sh f), Acc (Array sh g)) Source

Take an array of 7-tuples and return seven arrays, analogous to unzip.

unzip8 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h) => Acc (Array sh (a, b, c, d, e, f, g, h)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d), Acc (Array sh e), Acc (Array sh f), Acc (Array sh g), Acc (Array sh h)) Source

Take an array of 8-tuples and return eight arrays, analogous to unzip.

unzip9 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i) => Acc (Array sh (a, b, c, d, e, f, g, h, i)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d), Acc (Array sh e), Acc (Array sh f), Acc (Array sh g), Acc (Array sh h), Acc (Array sh i)) Source

Take an array of 8-tuples and return eight arrays, analogous to unzip.

Working with predicates

Filtering

filter :: Elt a => (Exp a -> Exp Bool) -> Acc (Vector a) -> Acc (Vector a) Source

Drop elements that do not satisfy the predicate

Scatter

scatter Source

Arguments

:: Elt e 
=> Acc (Vector Int)

index mapping

-> Acc (Vector e)

default

-> Acc (Vector e)

input

-> Acc (Vector e)

output

Copy elements from source array to destination array according to an index mapping. This is a forward-permute operation where a to vector encodes an input to output index mapping. Output elements for indices that are not mapped assume the default vector's value.

For example:

default = [0, 0, 0, 0, 0, 0, 0, 0, 0]
to      = [1, 3, 7, 2, 5, 8]
input   = [1, 9, 6, 4, 4, 2, 5]

output  = [0, 1, 4, 9, 0, 4, 0, 6, 2]

Note if the same index appears in the index mapping more than once, the result is undefined. It does not makes sense for the to vector to be larger than the input vector.

scatterIf Source

Arguments

:: (Elt e, Elt e') 
=> Acc (Vector Int)

index mapping

-> Acc (Vector e)

mask

-> (Exp e -> Exp Bool)

predicate

-> Acc (Vector e')

default

-> Acc (Vector e')

input

-> Acc (Vector e')

output

Conditionally copy elements from source array to destination array according to an index mapping. This is a forward-permute operation where a to vector encodes an input to output index mapping. In addition, there is a mask vector, and an associated predicate function. The mapping will only occur if the predicate function applied to the mask at that position resolves to True. If not copied, the output array assumes the default vector's value.

For example:

default = [0, 0, 0, 0, 0, 0, 0, 0, 0]
to      = [1, 3, 7, 2, 5, 8]
mask    = [3, 4, 9, 2, 7, 5]
pred    = (>* 4)
input   = [1, 9, 6, 4, 4, 2, 5]

output  = [0, 0, 0, 0, 0, 4, 0, 6, 2]

Note if the same index appears in the mapping more than once, the result is undefined. The to and mask vectors must be the same length. It does not make sense for these to be larger than the input vector.

Gather

gather Source

Arguments

:: Elt e 
=> Acc (Vector Int)

index mapping

-> Acc (Vector e)

input

-> Acc (Vector e)

output

Copy elements from source array to destination array according to a map. This is a backpermute operation where a map vector encodes the output to input index mapping.

For example:

input  = [1, 9, 6, 4, 4, 2, 0, 1, 2]
from   = [1, 3, 7, 2, 5, 3]

output = [9, 4, 1, 6, 2, 4]

gatherIf Source

Arguments

:: (Elt e, Elt e') 
=> Acc (Vector Int)

index mapping

-> Acc (Vector e)

mask

-> (Exp e -> Exp Bool)

predicate

-> Acc (Vector e')

default

-> Acc (Vector e')

input

-> Acc (Vector e')

output

Conditionally copy elements from source array to destination array according to an index mapping. This is a backpermute operation where a from vector encodes the output to input index mapping. In addition, there is a mask vector, and an associated predication function, that specifies whether an element will be copied. If not copied, the output array assumes the default vector's value.

For example:

default = [6, 6, 6, 6, 6, 6]
from    = [1, 3, 7, 2, 5, 3]
mask    = [3, 4, 9, 2, 7, 5]
pred    = (>* 4)
input   = [1, 9, 6, 4, 4, 2, 0, 1, 2]

output  = [6, 6, 1, 6, 2, 4]

Folding

fold :: (Shape ix, Elt a) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Array (ix :. Int) a) -> Acc (Array ix a) Source

Reduction of the innermost dimension of an array of arbitrary rank. The first argument needs to be an associative function to enable an efficient parallel implementation.

fold1 :: (Shape ix, Elt a) => (Exp a -> Exp a -> Exp a) -> Acc (Array (ix :. Int) a) -> Acc (Array ix a) Source

Variant of fold that requires the reduced array to be non-empty and doesn't need an default value. The first argument needs to be an associative function to enable an efficient parallel implementation.

foldAll :: (Shape sh, Elt a) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Array sh a) -> Acc (Scalar a) Source

Reduction of an array of arbitrary rank to a single scalar value.

fold1All :: (Shape sh, Elt a) => (Exp a -> Exp a -> Exp a) -> Acc (Array sh a) -> Acc (Scalar a) Source

Variant of foldAll that requires the reduced array to be non-empty and doesn't need an default value.

Segmented reductions

foldSeg :: (Shape ix, Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Array (ix :. Int) a) -> Acc (Segments i) -> Acc (Array (ix :. Int) a) Source

Segmented reduction along the innermost dimension. Performs one individual reduction per segment of the source array. These reductions proceed in parallel.

The source array must have at least rank 1. The Segments array determines the lengths of the logical sub-arrays, each of which is folded separately.

fold1Seg :: (Shape ix, Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Acc (Array (ix :. Int) a) -> Acc (Segments i) -> Acc (Array (ix :. Int) a) Source

Variant of foldSeg that requires all segments of the reduced array to be non-empty and doesn't need a default value.

The source array must have at least rank 1. The Segments array determines the lengths of the logical sub-arrays, each of which is folded separately.

Specialised folds

all :: (Shape sh, Elt e) => (Exp e -> Exp Bool) -> Acc (Array sh e) -> Acc (Scalar Bool) Source

Check if all elements satisfy a predicate

any :: (Shape sh, Elt e) => (Exp e -> Exp Bool) -> Acc (Array sh e) -> Acc (Scalar Bool) Source

Check if any element satisfies the predicate

and :: Shape sh => Acc (Array sh Bool) -> Acc (Scalar Bool) Source

Check if all elements are True

or :: Shape sh => Acc (Array sh Bool) -> Acc (Scalar Bool) Source

Check if any element is True

sum :: (Shape sh, Elt e, IsNum e) => Acc (Array sh e) -> Acc (Scalar e) Source

Compute the sum of elements

product :: (Shape sh, Elt e, IsNum e) => Acc (Array sh e) -> Acc (Scalar e) Source

Compute the product of the elements

minimum :: (Shape sh, Elt e, IsScalar e) => Acc (Array sh e) -> Acc (Scalar e) Source

Yield the minimum element of an array. The array must not be empty.

maximum :: (Shape sh, Elt e, IsScalar e) => Acc (Array sh e) -> Acc (Scalar e) Source

Yield the maximum element of an array. The array must not be empty.

Prefix sums (scans)

scanl :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a) Source

Data.List style left-to-right scan, but with the additional restriction that the first argument needs to be an associative function to enable an efficient parallel implementation. The initial value (second argument) may be arbitrary.

scanl1 :: Elt a => (Exp a -> Exp a -> Exp a) -> Acc (Vector a) -> Acc (Vector a) Source

Data.List style left-to-right scan without an initial value (aka inclusive scan). Again, the first argument needs to be an associative function. Denotationally, we have

scanl1 f e arr = tail (scanl f e arr)

scanl' :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> (Acc (Vector a), Acc (Scalar a)) Source

Variant of scanl, where the final result of the reduction is returned separately. Denotationally, we have

scanl' f e arr = (init res, unit (res!len))
  where
    len = shape arr
    res = scanl f e arr

scanr :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a) Source

Right-to-left variant of scanl.

scanr1 :: Elt a => (Exp a -> Exp a -> Exp a) -> Acc (Vector a) -> Acc (Vector a) Source

Right-to-left variant of scanl1.

scanr' :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> (Acc (Vector a), Acc (Scalar a)) Source

Right-to-left variant of scanl'.

prescanl :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a) Source

Left-to-right prescan (aka exclusive scan). As for scan, the first argument must be an associative function. Denotationally, we have

prescanl f e = Prelude.fst . scanl' f e

postscanl :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a) Source

Left-to-right postscan, a variant of scanl1 with an initial value. Denotationally, we have

postscanl f e = map (e `f`) . scanl1 f

prescanr :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a) Source

Right-to-left prescan (aka exclusive scan). As for scan, the first argument must be an associative function. Denotationally, we have

prescanr f e = Prelude.fst . scanr' f e

postscanr :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a) Source

Right-to-left postscan, a variant of scanr1 with an initial value. Denotationally, we have

postscanr f e = map (e `f`) . scanr1 f

Segmented scans

scanlSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a) Source

Segmented version of scanl

scanl1Seg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a) Source

Segmented version of scanl1.

scanl'Seg :: forall a i. (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a, Vector a) Source

Segmented version of scanl'

The first element of the resulting tuple is a vector of scanned values. The second element is a vector of segment scan totals and has the same size as the segment vector.

prescanlSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a) Source

Segmented version of prescanl.

postscanlSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a) Source

Segmented version of postscanl.

scanrSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a) Source

Segmented version of scanr.

scanr1Seg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a) Source

Segmented version of scanr1.

scanr'Seg :: forall a i. (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a, Vector a) Source

Segmented version of scanr'.

prescanrSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a) Source

Segmented version of prescanr.

postscanrSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a) Source

Segmented version of postscanr.

Stencil

stencil Source

Arguments

:: (Shape ix, Elt a, Elt b, Stencil ix a stencil) 
=> (stencil -> Exp b)

stencil function

-> Boundary a

boundary condition

-> Acc (Array ix a)

source array

-> Acc (Array ix b)

destination array

Map a stencil over an array. In contrast to map, the domain of a stencil function is an entire neighbourhood of each array element. Neighbourhoods are sub-arrays centred around a focal point. They are not necessarily rectangular, but they are symmetric in each dimension and have an extent of at least three in each dimensions — due to the symmetry requirement, the extent is necessarily odd. The focal point is the array position that is determined by the stencil.

For those array positions where the neighbourhood extends past the boundaries of the source array, a boundary condition determines the contents of the out-of-bounds neighbourhood positions.

stencil2 Source

Arguments

:: (Shape ix, Elt a, Elt b, Elt c, Stencil ix a stencil1, Stencil ix b stencil2) 
=> (stencil1 -> stencil2 -> Exp c)

binary stencil function

-> Boundary a

boundary condition #1

-> Acc (Array ix a)

source array #1

-> Boundary b

boundary condition #2

-> Acc (Array ix b)

source array #2

-> Acc (Array ix c)

destination array

Map a binary stencil of an array. The extent of the resulting array is the intersection of the extents of the two source arrays.

Specification

class (Elt (StencilRepr sh stencil), Stencil sh a (StencilRepr sh stencil)) => Stencil sh a stencil Source

Minimal complete definition

stencilPrj

Instances

Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) 
(Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row0) => Stencil ((:.) ((:.) sh Int) Int) a (row2, row1, row0) 
(Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row3, Stencil ((:.) sh Int) a row4, Stencil ((:.) sh Int) a row5) => Stencil ((:.) ((:.) sh Int) Int) a (row1, row2, row3, row4, row5) 
(Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row3, Stencil ((:.) sh Int) a row4, Stencil ((:.) sh Int) a row5, Stencil ((:.) sh Int) a row6, Stencil ((:.) sh Int) a row7) => Stencil ((:.) ((:.) sh Int) Int) a (row1, row2, row3, row4, row5, row6, row7) 
(Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row3, Stencil ((:.) sh Int) a row4, Stencil ((:.) sh Int) a row5, Stencil ((:.) sh Int) a row6, Stencil ((:.) sh Int) a row7, Stencil ((:.) sh Int) a row8, Stencil ((:.) sh Int) a row9) => Stencil ((:.) ((:.) sh Int) Int) a (row1, row2, row3, row4, row5, row6, row7, row8, row9) 

data Boundary a Source

Boundary condition specification for stencil operations.

Constructors

Clamp

clamp coordinates to the extent of the array

Mirror

mirror coordinates beyond the array extent

Wrap

wrap coordinates around on each dimension

Constant a

use a constant value for outlying coordinates

Instances

Read a => Read (Boundary a) 
Show a => Show (Boundary a) 

Common stencil patterns

type Stencil3 a = (Exp a, Exp a, Exp a) Source

type Stencil5 a = (Exp a, Exp a, Exp a, Exp a, Exp a) Source

type Stencil7 a = (Exp a, Exp a, Exp a, Exp a, Exp a, Exp a, Exp a) Source

type Stencil9 a = (Exp a, Exp a, Exp a, Exp a, Exp a, Exp a, Exp a, Exp a, Exp a) Source

Foreign

foreignAcc :: (Arrays acc, Arrays res, Foreign ff) => ff acc res -> (Acc acc -> Acc res) -> Acc acc -> Acc res Source

Call a foreign function. The form the function takes is dependent on the backend being used. The arguments are passed as either a single array or as a tuple of arrays. In addition a pure Accelerate version of the function needs to be provided to support backends other than the one being targeted.

foreignAcc2 :: (Arrays acc, Arrays res, Foreign ff1, Foreign ff2) => ff1 acc res -> ff2 acc res -> (Acc acc -> Acc res) -> Acc acc -> Acc res Source

Call a foreign function with foreign implementations for two different backends.

foreignAcc3 :: (Arrays acc, Arrays res, Foreign ff1, Foreign ff2, Foreign ff3) => ff1 acc res -> ff2 acc res -> ff3 acc res -> (Acc acc -> Acc res) -> Acc acc -> Acc res Source

Call a foreign function with foreign implementations for three different backends.

foreignExp :: (Elt e, Elt res, Foreign ff) => ff e res -> (Exp e -> Exp res) -> Exp e -> Exp res Source

Call a foreign expression function. The form the function takes is dependent on the backend being used. The arguments are passed as either a single scalar element or as a tuple of elements. In addition a pure Accelerate version of the function needs to be provided to support backends other than the one being targeted.

foreignExp2 :: (Elt e, Elt res, Foreign ff1, Foreign ff2) => ff1 e res -> ff2 e res -> (Exp e -> Exp res) -> Exp e -> Exp res Source

Call a foreign function with foreign implementations for two different backends.

foreignExp3 :: (Elt e, Elt res, Foreign ff1, Foreign ff2, Foreign ff3) => ff1 e res -> ff2 e res -> ff3 e res -> (Exp e -> Exp res) -> Exp e -> Exp res Source

Call a foreign function with foreign implementations for three different backends.

The Accelerate Expression Language

Scalar data types

data Exp t Source

Scalar expressions for plain array computations.

Instances

Unlift Exp () 
Unlift Exp Z 
Lift Exp Bool 
Lift Exp Char 
Lift Exp Double 
Lift Exp Float 
Lift Exp Int 
Lift Exp Int8 
Lift Exp Int16 
Lift Exp Int32 
Lift Exp Int64 
Lift Exp Word 
Lift Exp Word8 
Lift Exp Word16 
Lift Exp Word32 
Lift Exp Word64 
Lift Exp () 
Lift Exp CChar 
Lift Exp CSChar 
Lift Exp CUChar 
Lift Exp CShort 
Lift Exp CUShort 
Lift Exp CInt 
Lift Exp CUInt 
Lift Exp CLong 
Lift Exp CULong 
Lift Exp CLLong 
Lift Exp CULLong 
Lift Exp CFloat 
Lift Exp CDouble 
Lift Exp Z 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) 
Elt a => Unlift Exp (Complex (Exp a)) 
(Lift Exp a, Elt (Plain a)) => Lift Exp (Complex a) 
Shape sh => Lift Exp (Any sh) 
Lift Exp (Exp e) 
(Elt a, Elt b) => Unlift Exp (Exp a, Exp b) 
(Elt e, Slice (Plain ix), Unlift Exp ix) => Unlift Exp ((:.) ix (Exp e)) 
(Elt e, Slice ix) => Unlift Exp ((:.) (Exp ix) (Exp e)) 
(Lift Exp a, Lift Exp b, Elt (Plain a), Elt (Plain b)) => Lift Exp (a, b) 
(Elt e, Slice (Plain ix), Lift Exp ix) => Lift Exp ((:.) ix (Exp e)) 
(Slice (Plain ix), Lift Exp ix) => Lift Exp ((:.) ix All) 
(Slice (Plain ix), Lift Exp ix) => Lift Exp ((:.) ix Int) 
(Elt a, Elt b, Elt c) => Unlift Exp (Exp a, Exp b, Exp c) 
(Lift Exp a, Lift Exp b, Lift Exp c, Elt (Plain a), Elt (Plain b), Elt (Plain c)) => Lift Exp (a, b, c) 
(Elt a, Elt b, Elt c, Elt d) => Unlift Exp (Exp a, Exp b, Exp c, Exp d) 
(Lift Exp a, Lift Exp b, Lift Exp c, Lift Exp d, Elt (Plain a), Elt (Plain b), Elt (Plain c), Elt (Plain d)) => Lift Exp (a, b, c, d) 
(Elt a, Elt b, Elt c, Elt d, Elt e) => Unlift Exp (Exp a, Exp b, Exp c, Exp d, Exp e) 
(Lift Exp a, Lift Exp b, Lift Exp c, Lift Exp d, Lift Exp e, Elt (Plain a), Elt (Plain b), Elt (Plain c), Elt (Plain d), Elt (Plain e)) => Lift Exp (a, b, c, d, e) 
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) => Unlift Exp (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f) 
(Lift Exp a, Lift Exp b, Lift Exp c, Lift Exp d, Lift Exp e, Lift Exp f, Elt (Plain a), Elt (Plain b), Elt (Plain c), Elt (Plain d), Elt (Plain e), Elt (Plain f)) => Lift Exp (a, b, c, d, e, f) 
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g) => Unlift Exp (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g) 
(Lift Exp a, Lift Exp b, Lift Exp c, Lift Exp d, Lift Exp e, Lift Exp f, Lift Exp g, Elt (Plain a), Elt (Plain b), Elt (Plain c), Elt (Plain d), Elt (Plain e), Elt (Plain f), Elt (Plain g)) => Lift Exp (a, b, c, d, e, f, g) 
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h) => Unlift Exp (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h) 
(Lift Exp a, Lift Exp b, Lift Exp c, Lift Exp d, Lift Exp e, Lift Exp f, Lift Exp g, Lift Exp h, Elt (Plain a), Elt (Plain b), Elt (Plain c), Elt (Plain d), Elt (Plain e), Elt (Plain f), Elt (Plain g), Elt (Plain h)) => Lift Exp (a, b, c, d, e, f, g, h) 
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i) => Unlift Exp (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i) 
(Lift Exp a, Lift Exp b, Lift Exp c, Lift Exp d, Lift Exp e, Lift Exp f, Lift Exp g, Lift Exp h, Lift Exp i, Elt (Plain a), Elt (Plain b), Elt (Plain c), Elt (Plain d), Elt (Plain e), Elt (Plain f), Elt (Plain g), Elt (Plain h), Elt (Plain i)) => Lift Exp (a, b, c, d, e, f, g, h, i) 
(Elt t, IsBounded t) => Bounded (Exp t) 
(Elt t, IsScalar t) => Enum (Exp t) 
(Elt t, IsScalar t) => Eq (Exp t) 
(Elt t, IsFloating t) => Floating (Exp t) 
(Elt a, IsFloating a, RealFloat a) => Floating (Exp (Complex a)) 
(Elt t, IsFloating t) => Fractional (Exp t) 
(Elt a, IsFloating a) => Fractional (Exp (Complex a)) 
(Elt t, IsIntegral t) => Integral (Exp t) 
(Elt t, IsNum t) => Num (Exp t) 
(Elt a, IsFloating a) => Num (Exp (Complex a)) 
(Elt t, IsScalar t) => Ord (Exp t) 
(Elt t, IsNum t) => Real (Exp t) 
(Elt t, IsFloating t) => RealFloat (Exp t) 
(Elt t, IsFloating t) => RealFrac (Exp t) 
Elt e => Show (Exp e) 
(Elt t, IsNum t, IsIntegral t) => Bits (Exp t) 
Function (Exp a -> f) => Show (Exp a -> f) 
Typeable (* -> *) Exp 
type Plain (Exp e) = e 
type Plain ((:.) ix (Exp e)) = (:.) (Plain ix) e 

Type classes

class (Floating a, IsScalar a, IsNum a) => IsFloating a Source

Floating types

Minimal complete definition

floatingType

class IsNonNum a Source

Non-numeric types

Minimal complete definition

nonNumType

Element types

data Int :: *

A fixed-precision integer type with at least the range [-2^29 .. 2^29-1]. The exact range for a given implementation can be determined by using minBound and maxBound from the Bounded class.

Instances

Bounded Int 
Enum Int 
Eq Int 
Integral Int 
Data Int 
Num Int 
Ord Int 
Read Int 
Real Int 
Show Int 
Ix Int 
Generic Int 
PrintfArg Int 
Storable Int 
Bits Int 
FiniteBits Int 
Lift Int 
IsScalar Int 
IsBounded Int 
IsNum Int 
IsIntegral Int 
Elt Int 
Hashable Int 
Unbox Int 
Prim Int 
Typeable * Int 
IArray UArray Int 
Lift Exp Int 
MVector MVector Int 
Vector Vector Int 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) 
(Slice (Plain ix), Lift Exp ix) => Lift Exp ((:.) ix Int) 
Elt e => IsList (Vector e) 
Shape sh => Elt (Any ((:.) sh Int)) 
MArray (STUArray s) Int (ST s) 
Slice sl => Slice ((:.) sl Int) 
Shape sh => Shape ((:.) sh Int) 
(Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row0) => Stencil ((:.) ((:.) sh Int) Int) a (row2, row1, row0) 
(Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row3, Stencil ((:.) sh Int) a row4, Stencil ((:.) sh Int) a row5) => Stencil ((:.) ((:.) sh Int) Int) a (row1, row2, row3, row4, row5) 
(Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row3, Stencil ((:.) sh Int) a row4, Stencil ((:.) sh Int) a row5, Stencil ((:.) sh Int) a row6, Stencil ((:.) sh Int) a row7) => Stencil ((:.) ((:.) sh Int) Int) a (row1, row2, row3, row4, row5, row6, row7) 
(Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row3, Stencil ((:.) sh Int) a row4, Stencil ((:.) sh Int) a row5, Stencil ((:.) sh Int) a row6, Stencil ((:.) sh Int) a row7, Stencil ((:.) sh Int) a row8, Stencil ((:.) sh Int) a row9) => Stencil ((:.) ((:.) sh Int) Int) a (row1, row2, row3, row4, row5, row6, row7, row8, row9) 
type Rep Int = D1 D_Int (C1 C_Int (S1 NoSelector (Rec0 Int))) 
type Plain Int = Int 
data Vector Int = V_Int (Vector Int) 
data MVector s Int = MV_Int (MVector s Int) 
type Item (Vector e) = e 
type SliceShape ((:.) sl Int) = SliceShape sl 
type CoSliceShape ((:.) sl Int) = (:.) (CoSliceShape sl) Int 
type FullShape ((:.) sl Int) = (:.) (FullShape sl) Int 
type Plain ((:.) ix Int) = (:.) (Plain ix) Int 

data Int8 :: *

8-bit signed integer type

Instances

Bounded Int8 
Enum Int8 
Eq Int8 
Integral Int8 
Data Int8 
Num Int8 
Ord Int8 
Read Int8 
Real Int8 
Show Int8 
Ix Int8 
PrintfArg Int8 
Storable Int8 
Bits Int8 
FiniteBits Int8 
IsScalar Int8 
IsBounded Int8 
IsNum Int8 
IsIntegral Int8 
Elt Int8 
Hashable Int8 
Unbox Int8 
Prim Int8 
Typeable * Int8 
IArray UArray Int8 
Lift Exp Int8 
MVector MVector Int8 
Vector Vector Int8 
MArray (STUArray s) Int8 (ST s) 
type Plain Int8 = Int8 
data Vector Int8 = V_Int8 (Vector Int8) 
data MVector s Int8 = MV_Int8 (MVector s Int8) 

data Int16 :: *

16-bit signed integer type

data Int32 :: *

32-bit signed integer type

data Int64 :: *

64-bit signed integer type

data Word :: *

A Word is an unsigned integral type, with the same size as Int.

Instances

Bounded Word 
Enum Word 
Eq Word 
Integral Word 
Data Word 
Num Word 
Ord Word 
Read Word 
Real Word 
Show Word 
Ix Word 
PrintfArg Word 
Storable Word 
Bits Word 
FiniteBits Word 
IsScalar Word 
IsBounded Word 
IsNum Word 
IsIntegral Word 
Elt Word 
Hashable Word 
Unbox Word 
Prim Word 
Typeable * Word 
IArray UArray Word 
Lift Exp Word 
MVector MVector Word 
Vector Vector Word 
MArray (STUArray s) Word (ST s) 
type Plain Word = Word 
data Vector Word = V_Word (Vector Word) 
data MVector s Word = MV_Word (MVector s Word) 

data Word8 :: *

8-bit unsigned integer type

data Word16 :: *

16-bit unsigned integer type

data Word32 :: *

32-bit unsigned integer type

data Word64 :: *

64-bit unsigned integer type

data Float :: *

Single-precision floating point numbers. It is desirable that this type be at least equal in range and precision to the IEEE single-precision type.

Instances

data Double :: *

Double-precision floating point numbers. It is desirable that this type be at least equal in range and precision to the IEEE double-precision type.

data Bool :: *

Instances

Bounded Bool 
Enum Bool 
Eq Bool 
Data Bool 
Ord Bool 
Read Bool 
Show Bool 
Ix Bool 
Generic Bool 
Storable Bool 
Bits Bool 
FiniteBits Bool 
Lift Bool 
IsScalar Bool 
IsBounded Bool 
IsNonNum Bool 
Elt Bool 
Hashable Bool 
Unbox Bool 
Typeable * Bool 
IArray UArray Bool 
Lift Exp Bool 
MVector MVector Bool 
Vector Vector Bool 
MArray (STUArray s) Bool (ST s) 
type Rep Bool = D1 D1Bool ((:+:) (C1 C1_0Bool U1) (C1 C1_1Bool U1)) 
type Plain Bool = Bool 
data Vector Bool = V_Bool (Vector Word8) 
data MVector s Bool = MV_Bool (MVector s Word8) 
type (==) Bool a b = EqBool a b 

data Char :: *

The character type Char is an enumeration whose values represent Unicode (or equivalently ISO/IEC 10646) characters (see http://www.unicode.org/ for details). This set extends the ISO 8859-1 (Latin-1) character set (the first 256 characters), which is itself an extension of the ASCII character set (the first 128 characters). A character literal in Haskell has type Char.

To convert a Char to or from the corresponding Int value defined by Unicode, use toEnum and fromEnum from the Enum class respectively (or equivalently ord and chr).

Instances

Bounded Char 
Enum Char 
Eq Char 
Data Char 
Ord Char 
Read Char 
Show Char 
Ix Char 
Generic Char 
PrintfArg Char 
IsChar Char 
Storable Char 
Lift Char 
IsScalar Char 
IsBounded Char 
IsNonNum Char 
Elt Char 
Hashable Char 
Unbox Char 
Prim Char 
Typeable * Char 
IArray UArray Char 
Lift Exp Char 
MVector MVector Char 
Vector Vector Char 
MArray (STUArray s) Char (ST s) 
type Rep Char = D1 D_Char (C1 C_Char (S1 NoSelector (Rec0 Char))) 
type Plain Char = Char 
data Vector Char = V_Char (Vector Char) 
data MVector s Char = MV_Char (MVector s Char) 

Lifting and Unlifting

A value of type Int is a plain Haskell value (unlifted), whereas an Exp Int is a lifted value, that is, an integer lifted into the domain of expressions (an abstract syntax tree in disguise). Both Acc and Exp are surface types into which values may be lifted. Lifting plain array and scalar surface types is equivalent to use and constant respectively.

In general an Exp Int cannot be unlifted into an Int, because the actual number will not be available until a later stage of execution (e.g. during GPU execution, when run is called). Similarly an Acc array can not be unlifted to a vanilla array; you should instead run the expression with a specific backend to evaluate it.

Lifting and unlifting are also used to pack and unpack an expression into and out of constructors such as tuples, respectively. Those expressions, at runtime, will become tuple dereferences. For example:

Exp (Z :. Int :. Int)
    -> unlift    :: (Z :. Exp Int :. Exp Int)
    -> lift      :: Exp (Z :. Int :. Int)
    -> ...
Acc (Scalar Int, Vector Float)
    -> unlift    :: (Acc (Scalar Int), Acc (Vector Float))
    -> lift      :: Acc (Scalar Int, Vector Float)
    -> ...

class Lift c e where Source

The class of types e which can be lifted into c.

Associated Types

type Plain e Source

An associated-type (i.e. a type-level function) that strips all instances of surface type constructors c from the input type e.

For example, the tuple types (Exp Int, Int) and (Int, Exp Int) have the same "Plain" representation. That is, the following type equality holds:

Plain (Exp Int, Int) ~ (Int,Int) ~ Plain (Int, Exp Int)

Methods

lift :: e -> c (Plain e) Source

Lift the given value into a surface type c --- either Exp for scalar expressions or Acc for array computations. The value may already contain subexpressions in c.

Instances

Lift Exp Bool 
Lift Exp Char 
Lift Exp Double 
Lift Exp Float 
Lift Exp Int 
Lift Exp Int8 
Lift Exp Int16 
Lift Exp Int32 
Lift Exp Int64 
Lift Exp Word 
Lift Exp Word8 
Lift Exp Word16 
Lift Exp Word32 
Lift Exp Word64 
Lift Exp () 
Lift Exp CChar 
Lift Exp CSChar 
Lift Exp CUChar 
Lift Exp CShort 
Lift Exp CUShort 
Lift Exp CInt 
Lift Exp CUInt 
Lift Exp CLong 
Lift Exp CULong 
Lift Exp CLLong 
Lift Exp CULLong 
Lift Exp CFloat 
Lift Exp CDouble 
Lift Exp Z 
(Lift Exp a, Elt (Plain a)) => Lift Exp (Complex a) 
Shape sh => Lift Exp (Any sh) 
Lift Exp (Exp e) 
Lift Acc (Acc a) 
(Lift Exp a, Lift Exp b, Elt (Plain a), Elt (Plain b)) => Lift Exp (a, b) 
(Elt e, Slice (Plain ix), Lift Exp ix) => Lift Exp ((:.) ix (Exp e)) 
(Slice (Plain ix), Lift Exp ix) => Lift Exp ((:.) ix All) 
(Slice (Plain ix), Lift Exp ix) => Lift Exp ((:.) ix Int) 
(Lift Acc a, Lift Acc b, Arrays (Plain a), Arrays (Plain b)) => Lift Acc (a, b) 
(Shape sh, Elt e) => Lift Acc (Array sh e) 
(Lift Exp a, Lift Exp b, Lift Exp c, Elt (Plain a), Elt (Plain b), Elt (Plain c)) => Lift Exp (a, b, c) 
(Lift Acc a, Lift Acc b, Lift Acc c, Arrays (Plain a), Arrays (Plain b), Arrays (Plain c)) => Lift Acc (a, b, c) 
(Lift Exp a, Lift Exp b, Lift Exp c, Lift Exp d, Elt (Plain a), Elt (Plain b), Elt (Plain c), Elt (Plain d)) => Lift Exp (a, b, c, d) 
(Lift Acc a, Lift Acc b, Lift Acc c, Lift Acc d, Arrays (Plain a), Arrays (Plain b), Arrays (Plain c), Arrays (Plain d)) => Lift Acc (a, b, c, d) 
(Lift Exp a, Lift Exp b, Lift Exp c, Lift Exp d, Lift Exp e, Elt (Plain a), Elt (Plain b), Elt (Plain c), Elt (Plain d), Elt (Plain e)) => Lift Exp (a, b, c, d, e) 
(Lift Acc a, Lift Acc b, Lift Acc c, Lift Acc d, Lift Acc e, Arrays (Plain a), Arrays (Plain b), Arrays (Plain c), Arrays (Plain d), Arrays (Plain e)) => Lift Acc (a, b, c, d, e) 
(Lift Exp a, Lift Exp b, Lift Exp c, Lift Exp d, Lift Exp e, Lift Exp f, Elt (Plain a), Elt (Plain b), Elt (Plain c), Elt (Plain d), Elt (Plain e), Elt (Plain f)) => Lift Exp (a, b, c, d, e, f) 
(Lift Acc a, Lift Acc b, Lift Acc c, Lift Acc d, Lift Acc e, Lift Acc f, Arrays (Plain a), Arrays (Plain b), Arrays (Plain c), Arrays (Plain d), Arrays (Plain e), Arrays (Plain f)) => Lift Acc (a, b, c, d, e, f) 
(Lift Exp a, Lift Exp b, Lift Exp c, Lift Exp d, Lift Exp e, Lift Exp f, Lift Exp g, Elt (Plain a), Elt (Plain b), Elt (Plain c), Elt (Plain d), Elt (Plain e), Elt (Plain f), Elt (Plain g)) => Lift Exp (a, b, c, d, e, f, g) 
(Lift Acc a, Lift Acc b, Lift Acc c, Lift Acc d, Lift Acc e, Lift Acc f, Lift Acc g, Arrays (Plain a), Arrays (Plain b), Arrays (Plain c), Arrays (Plain d), Arrays (Plain e), Arrays (Plain f), Arrays (Plain g)) => Lift Acc (a, b, c, d, e, f, g) 
(Lift Exp a, Lift Exp b, Lift Exp c, Lift Exp d, Lift Exp e, Lift Exp f, Lift Exp g, Lift Exp h, Elt (Plain a), Elt (Plain b), Elt (Plain c), Elt (Plain d), Elt (Plain e), Elt (Plain f), Elt (Plain g), Elt (Plain h)) => Lift Exp (a, b, c, d, e, f, g, h) 
(Lift Acc a, Lift Acc b, Lift Acc c, Lift Acc d, Lift Acc e, Lift Acc f, Lift Acc g, Lift Acc h, Arrays (Plain a), Arrays (Plain b), Arrays (Plain c), Arrays (Plain d), Arrays (Plain e), Arrays (Plain f), Arrays (Plain g), Arrays (Plain h)) => Lift Acc (a, b, c, d, e, f, g, h) 
(Lift Exp a, Lift Exp b, Lift Exp c, Lift Exp d, Lift Exp e, Lift Exp f, Lift Exp g, Lift Exp h, Lift Exp i, Elt (Plain a), Elt (Plain b), Elt (Plain c), Elt (Plain d), Elt (Plain e), Elt (Plain f), Elt (Plain g), Elt (Plain h), Elt (Plain i)) => Lift Exp (a, b, c, d, e, f, g, h, i) 
(Lift Acc a, Lift Acc b, Lift Acc c, Lift Acc d, Lift Acc e, Lift Acc f, Lift Acc g, Lift Acc h, Lift Acc i, Arrays (Plain a), Arrays (Plain b), Arrays (Plain c), Arrays (Plain d), Arrays (Plain e), Arrays (Plain f), Arrays (Plain g), Arrays (Plain h), Arrays (Plain i)) => Lift Acc (a, b, c, d, e, f, g, h, i) 

class Lift c e => Unlift c e where Source

A limited subset of types which can be lifted, can also be unlifted.

Methods

unlift :: c (Plain e) -> e Source

Unlift the outermost constructor through the surface type. This is only possible if the constructor is fully determined by its type - i.e., it is a singleton.

Instances

Unlift Exp () 
Unlift Exp Z 
Elt a => Unlift Exp (Complex (Exp a)) 
(Elt a, Elt b) => Unlift Exp (Exp a, Exp b) 
(Elt e, Slice (Plain ix), Unlift Exp ix) => Unlift Exp ((:.) ix (Exp e)) 
(Elt e, Slice ix) => Unlift Exp ((:.) (Exp ix) (Exp e)) 
(Arrays a, Arrays b) => Unlift Acc (Acc a, Acc b) 
(Elt a, Elt b, Elt c) => Unlift Exp (Exp a, Exp b, Exp c) 
(Arrays a, Arrays b, Arrays c) => Unlift Acc (Acc a, Acc b, Acc c) 
(Elt a, Elt b, Elt c, Elt d) => Unlift Exp (Exp a, Exp b, Exp c, Exp d) 
(Arrays a, Arrays b, Arrays c, Arrays d) => Unlift Acc (Acc a, Acc b, Acc c, Acc d) 
(Elt a, Elt b, Elt c, Elt d, Elt e) => Unlift Exp (Exp a, Exp b, Exp c, Exp d, Exp e) 
(Arrays a, Arrays b, Arrays c, Arrays d, Arrays e) => Unlift Acc (Acc a, Acc b, Acc c, Acc d, Acc e) 
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) => Unlift Exp (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f) 
(Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f) => Unlift Acc (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f) 
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g) => Unlift Exp (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g) 
(Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g) => Unlift Acc (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g) 
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h) => Unlift Exp (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h) 
(Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h) => Unlift Acc (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h) 
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i) => Unlift Exp (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i) 
(Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i) => Unlift Acc (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i) 

lift1 :: (Unlift Exp e1, Lift Exp e2) => (e1 -> e2) -> Exp (Plain e1) -> Exp (Plain e2) Source

Lift a unary function into Exp.

lift2 :: (Unlift Exp e1, Unlift Exp e2, Lift Exp e3) => (e1 -> e2 -> e3) -> Exp (Plain e1) -> Exp (Plain e2) -> Exp (Plain e3) Source

Lift a binary function into Exp.

ilift1 :: (Exp Int -> Exp Int) -> Exp DIM1 -> Exp DIM1 Source

Lift a unary function to a computation over rank-1 indices.

ilift2 :: (Exp Int -> Exp Int -> Exp Int) -> Exp DIM1 -> Exp DIM1 -> Exp DIM1 Source

Lift a binary function to a computation over rank-1 indices.

Operations

Some of the standard Haskell 98 typeclass functions need to be reimplemented because their types change. If so, function names kept the same and infix operations are suffixed by an asterisk. If not reimplemented here, the standard typeclass instances apply.

Introduction

constant :: Elt t => t -> Exp t Source

Scalar expression inlet: make a Haskell value available for processing in an Accelerate scalar expression.

Note that this embeds the value directly into the expression. Depending on the backend used to execute the computation, this might not always be desirable. For example, a backend that does external code generation may embed this constant directly into the generated code, which means new code will need to be generated and compiled every time the value changes. In such cases, consider instead lifting scalar values into (singleton) arrays so that they can be passed as an input to the computation and thus the value can change without the need to generate fresh code.

Tuples

fst :: forall a b. (Elt a, Elt b) => Exp (a, b) -> Exp a Source

Extract the first component of a scalar pair.

afst :: forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc a Source

Extract the first component of an array pair.

snd :: forall a b. (Elt a, Elt b) => Exp (a, b) -> Exp b Source

Extract the second component of a scalar pair.

asnd :: forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc b Source

Extract the second component of an array pair

curry :: Lift f (f a, f b) => (f (Plain (f a), Plain (f b)) -> f c) -> f a -> f b -> f c Source

Converts an uncurried function to a curried function.

uncurry :: Unlift f (f a, f b) => (f a -> f b -> f c) -> f (Plain (f a), Plain (f b)) -> f c Source

Converts a curried function to a function on pairs.

Flow control

(?) :: Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t infix 0 Source

An infix version of cond. If the predicate evaluates to True, the first component of the tuple is returned, else the second.

caseof Source

Arguments

:: (Elt a, Elt b) 
=> Exp a

case subject

-> [(Exp a -> Exp Bool, Exp b)]

list of cases to attempt

-> Exp b

default value

-> Exp b 

A case-like control structure

cond Source

Arguments

:: Elt t 
=> Exp Bool

condition

-> Exp t

then-expression

-> Exp t

else-expression

-> Exp t 

A scalar-level if-then-else construct.

while :: Elt e => (Exp e -> Exp Bool) -> (Exp e -> Exp e) -> Exp e -> Exp e Source

While construct. Continue to apply the given function, starting with the initial value, until the test function evaluates to true.

iterate :: forall a. Elt a => Exp Int -> (Exp a -> Exp a) -> Exp a -> Exp a Source

Repeatedly apply a function a fixed number of times

Scalar reduction

sfoldl :: forall sh a b. (Shape sh, Slice sh, Elt a, Elt b) => (Exp a -> Exp b -> Exp a) -> Exp a -> Exp sh -> Acc (Array (sh :. Int) b) -> Exp a Source

Reduce along an innermost slice of an array sequentially, by applying a binary operator to a starting value and the array from left to right.

Basic operations

(&&*) :: Exp Bool -> Exp Bool -> Exp Bool infixr 3 Source

Conjunction

(||*) :: Exp Bool -> Exp Bool -> Exp Bool infixr 2 Source

Disjunction

not :: Exp Bool -> Exp Bool Source

Negation

(==*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool infix 4 Source

Equality lifted into Accelerate expressions.

(/=*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool infix 4 Source

Inequality lifted into Accelerate expressions.

(<*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool infix 4 Source

Smaller-than lifted into Accelerate expressions.

(<=*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool infix 4 Source

Smaller-or-equal lifted into Accelerate expressions.

(>*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool infix 4 Source

Greater-than lifted into Accelerate expressions.

(>=*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool infix 4 Source

Greater-or-equal lifted into Accelerate expressions.

Numeric functions

truncate :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b Source

truncate x returns the integer nearest x between zero and x.

round :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b Source

round x returns the nearest integer to x, or the even integer if x is equidistant between two integers.

floor :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b Source

floor x returns the greatest integer not greater than x.

ceiling :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b Source

ceiling x returns the least integer not less than x.

even :: (Elt a, IsIntegral a) => Exp a -> Exp Bool Source

return if the integer is even

odd :: (Elt a, IsIntegral a) => Exp a -> Exp Bool Source

return if the integer is odd

Bitwise functions

bit :: (Elt t, IsIntegral t) => Exp Int -> Exp t Source

bit i is a value with the ith bit set and all other bits clear

setBit :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source

x `setBit` i is the same as x .|. bit i

clearBit :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source

x `clearBit` i is the same as x .&. complement (bit i)

complementBit :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source

x `complementBit` i is the same as x `xor` bit i

testBit :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp Bool Source

Return True if the nth bit of the argument is 1

shift :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source

shift x i shifts x left by i bits if i is positive, or right by -i bits otherwise. Right shifts perform sign extension on signed number types; i.e. they fill the top bits with 1 if the x is negative and with 0 otherwise.

shiftL :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source

Shift the argument left by the specified number of bits (which must be non-negative).

shiftR :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source

Shift the first argument right by the specified number of bits. The result is undefined for negative shift amounts and shift amounts greater or equal to the bitSize.

Right shifts perform sign extension on signed number types; i.e. they fill the top bits with 1 if the x is negative and with 0 otherwise.

rotate :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source

rotate x i rotates x left by i bits if i is positive, or right by -i bits otherwise.

rotateL :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source

Rotate the argument left by the specified number of bits (which must be non-negative).

rotateR :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source

Rotate the argument right by the specified number of bits (which must be non-negative).

Shape manipulation

index0 :: Exp Z Source

The one index for a rank-0 array.

index1 :: Elt i => Exp i -> Exp (Z :. i) Source

Turn an Int expression into a rank-1 indexing expression.

unindex1 :: Elt i => Exp (Z :. i) -> Exp i Source

Turn a rank-1 indexing expression into an Int expression.

index2 :: (Elt i, Slice (Z :. i)) => Exp i -> Exp i -> Exp ((Z :. i) :. i) Source

Creates a rank-2 index from two Exp Int`s

unindex2 :: forall i. (Elt i, Slice (Z :. i)) => Exp ((Z :. i) :. i) -> Exp (i, i) Source

Destructs a rank-2 index to an Exp tuple of two Int`s.

indexHead :: Slice sh => Exp (sh :. Int) -> Exp Int Source

Get the outermost dimension of a shape

indexTail :: Slice sh => Exp (sh :. Int) -> Exp sh Source

Get all but the outermost element of a shape

toIndex :: Shape sh => Exp sh -> Exp sh -> Exp Int Source

Map a multi-dimensional index into a linear, row-major representation of an array. The first argument is the array shape, the second is the index.

fromIndex :: Shape sh => Exp sh -> Exp Int -> Exp sh Source

Inverse of fromIndex

intersect :: Shape sh => Exp sh -> Exp sh -> Exp sh Source

Intersection of two shapes

Conversions

ord :: Exp Char -> Exp Int Source

Convert a character to an Int.

chr :: Exp Int -> Exp Char Source

Convert an Int into a character.

boolToInt :: Exp Bool -> Exp Int Source

Convert a Boolean value to an Int, where False turns into '0' and True into '1'.

fromIntegral :: (Elt a, Elt b, IsIntegral a, IsNum b) => Exp a -> Exp b Source

General coercion from integral types

Plain arrays

Operations

arrayDim :: Shape sh => sh -> Int Source

Rank of an array.

arrayShape :: Shape sh => Array sh e -> sh Source

Array shape in plain Haskell code.

arraySize :: Shape sh => sh -> Int Source

Total number of elements in an array of the given Shape.

indexArray :: Array sh e -> sh -> e Source

Array indexing in plain Haskell code.

Conversions

For additional conversion routines, see the accelerate-io package: http://hackage.haskell.org/package/accelerate-io

Function

fromFunction :: (Shape sh, Elt e) => sh -> (sh -> e) -> Array sh e Source

Create an array from its representation function.

Lists

fromList :: (Shape sh, Elt e) => sh -> [e] -> Array sh e Source

Convert a list, with elements in row-major order, into an accelerated array.

toList :: forall sh e. Array sh e -> [e] Source

Convert an accelerated array to a list in row-major order.

IArray

fromIArray :: (EltRepr ix ~ EltRepr sh, IArray a e, Ix ix, Shape sh, Elt ix, Elt e) => a ix e -> Array sh e Source

Convert an IArray to an accelerated array.

While the type signature mentions Accelerate internals that are not exported, in practice satisfying the type equality is straight forward. The index type ix must be the unit type () for singleton arrays, or an Int or tuple of Int's for multidimensional arrays.

toIArray :: (EltRepr ix ~ EltRepr sh, IArray a e, Ix ix, Shape sh, Elt ix, Elt e) => Array sh e -> a ix e Source

Convert an accelerated array to an IArray.