accelerate-0.9.0.1: An embedded language for accelerated array processing

Portabilitynon-portable (GHC extensions)
Stabilityexperimental
MaintainerManuel M T Chakravarty <chak@cse.unsw.edu.au>
Safe HaskellNone

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 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 toplevel modules. Currently, we have the following:

Synopsis

Scalar 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 
Num Int 
Ord Int 
Read Int 
Real Int 
Show Int 
Ix Int 
Typeable Int 
Generic Int 
Storable Int 
Bits Int 
IsScalar Int 
IsBounded Int 
IsNum Int 
IsIntegral Int 
ArrayElt Int 
Elt Int 
Lift Int 
IArray UArray Int 
Elt e => Stencil DIM1 e (e, e, e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (e, e, e, e, e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (e, e, e, e, e, e, 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 (e, e, e, e, e, e, e, e, e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) 
Shape sh => Elt (Any (:. sh Int)) 
MArray (STUArray s) Int (ST s) 
Slice sl => Slice (sl, Int) 
Shape sh => Shape (sh, Int) 
Slice sl => Slice (:. sl Int) 
Shape sh => Shape (:. sh Int) 
(Slice (Plain ix), Lift ix) => Lift (:. ix Int) 
(Stencil (:. sh Int) a row1, Stencil (:. sh Int) a row2, Stencil (:. sh Int) a row3) => Stencil (:. (:. sh Int) Int) a (row1, row2, row3) 
(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) 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) 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) 
(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 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.

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 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).

Scalar type classes

Array data types

class (Delayable arrs, Typeable arrs) => Arrays arrs Source

Tuples of arrays (of type 'Array dim e'). This characterises the domain of results of Accelerate array computations.

Instances

Arrays () 
(Arrays arrs1, Arrays arrs2) => Arrays (arrs1, arrs2) 
(Shape sh, Elt e) => Arrays (Array sh e) 

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

Typeable2 Array 
Show (Array sh e) 
Delayable (Array sh e) 
(Shape sh, Elt e) => Arrays (Array sh e) 

type Scalar e = Array DIM0 eSource

Scalars

type Vector e = Array DIM1 eSource

Vectors

type Segments = Vector IntSource

Segment descriptor

Array element types

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

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

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 All 
Elt Z 
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) 

Array shapes & indices

data Z Source

Surface types representing array indices and slices ----------------------------------------------------

Array indices are snoc type lists

For example, the type of a rank-2 array index is 'Z :.Int :. Int'.

Rank-0 index

Constructors

Z 

Instances

Show Z 
Typeable Z 
Slice Z 
Shape Z 
Elt Z 
Unlift Z 
Lift Z 
Elt e => Stencil DIM1 e (e, e, e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (e, e, e, e, e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (e, e, e, e, e, e, 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 (e, e, e, e, e, e, e, e, 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 (Any Z) 

data tail :. head Source

Increase an index rank by one dimension

Constructors

tail :. head 

Instances

Typeable2 :. 
Elt e => Stencil DIM1 e (e, e, e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (e, e, e, e, e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e) 
Elt e => Stencil DIM1 e (e, e, e, e, e, e, 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 (e, e, e, e, e, e, e, e, e) 
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) 
Shape sh => Elt (Any (:. sh Int)) 
(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) 
(Elt e, Slice (Plain ix), Unlift ix) => Unlift (:. ix (Exp e)) 
(Elt e, Slice (Plain ix), Lift ix) => Lift (:. ix (Exp e)) 
(Slice (Plain ix), Lift ix) => Lift (:. ix All) 
(Slice (Plain ix), Lift ix) => Lift (:. ix Int) 
(Stencil (:. sh Int) a row1, Stencil (:. sh Int) a row2, Stencil (:. sh Int) a row3) => Stencil (:. (:. sh Int) Int) a (row1, row2, row3) 
(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) 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) 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) 
(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) 

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

Shapes and indices of multi-dimensional arrays

Instances

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

data All Source

Marker for entire dimensions in slice descriptors

Constructors

All 

Instances

Show All 
Typeable All 
Elt All 
Slice sl => Slice (:. sl All) 
(Slice (Plain ix), Lift ix) => Lift (:. ix All) 

data Any sh Source

Marker for arbitrary shapes in slice descriptors

Constructors

Any 

Instances

Typeable1 Any 
Show (Any sh) 
Shape sh => Slice (Any sh) 
Shape sh => Elt (Any (:. sh Int)) 
Elt (Any Z) 
Shape sh => Lift (Any sh) 

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

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

Associated Types

type SliceShape sl :: *Source

type CoSliceShape sl :: *Source

type FullShape sl :: *Source

Instances

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

type DIM0 = ZSource

Operations to use Accelerate arrays from plain Haskell

arrayDim :: Shape sh => sh -> IntSource

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

Array shape in plain Haskell code

arraySize :: Shape sh => sh -> IntSource

indexArray :: Array sh e -> sh -> eSource

Array indexing in plain Haskell code

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

Convert an IArray to an accelerated array.

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

Convert an accelerated array to an IArray

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

Convert a list (with elements in row-major order) to an accelerated array.

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

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

The Accelerate language

Array and scalar expressions

data Acc a Source

Array-valued collective computations

Instances

Typeable1 Acc 
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 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 t, IsFloating t) => Fractional (Exp t) 
(Elt t, IsIntegral t) => Integral (Exp t) 
(Elt t, IsNum t) => Num (Exp t) 
(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) 
Show (Exp a) 
Arrays arrs => Show (Acc arrs) 
(Elt t, IsNum t, IsIntegral t) => Bits (Exp t) 
Lift (Exp e) 
(Elt a, Elt b) => Unlift (Exp a, Exp b) 
(Elt e, Slice (Plain ix), Unlift ix) => Unlift (:. ix (Exp e)) 
(Elt e, Slice (Plain ix), Lift ix) => Lift (:. ix (Exp e)) 
(Elt a, Elt b, Elt c) => Unlift (Exp a, Exp b, Exp c) 
(Elt a, Elt b, Elt c, Elt d) => Unlift (Exp a, Exp b, Exp c, Exp d) 
(Elt a, Elt b, Elt c, Elt d, Elt e) => Unlift (Exp a, Exp b, Exp c, Exp d, Exp e) 
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) => Unlift (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f) 
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g) => Unlift (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g) 
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h) => Unlift (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h) 
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i) => Unlift (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i) 

type Exp t = PreExp Acc tSource

Scalar expressions for plain array computations.

Stencil specification

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) 

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

Smart constructors for stencil reification -------------------------------------------

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) 

Common stencil types

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

Scalar introduction

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

Constant scalar expression

Array construction

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

Array inlet: makes an array available for processing using the Accelerate language; triggers asynchronous host->device transfer if necessary.

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.

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 (Z :.2 :.All :.3) arr

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

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.

fstA :: (Shape sh1, Shape sh2, Elt e1, Elt e2) => Acc (Array sh1 e1, Array sh2 e2) -> Acc (Array sh1 e1)Source

Extract the first component of an array pair.

sndA :: (Shape sh1, Shape sh2, Elt e1, Elt e2) => Acc (Array sh1 e1, Array sh2 e2) -> Acc (Array sh2 e2)Source

Extract the second component of an array pair.

pairA :: (Shape sh1, Shape sh2, Elt e1, Elt e2) => Acc (Array sh1 e1) -> Acc (Array sh2 e2) -> Acc (Array sh1 e1, Array sh2 e2)Source

Create an array pair from two separate 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, where

 precondition: size ix == size ix'

Extraction of subarrays

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 all dimensions in their entirety.

Map-like functions

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

Apply the given function elementwise to the given array.

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 elementwise to the two arrays. The extent of the resulting array is the intersection of the extents of the two source arrays.

Reductions

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.

foldSeg :: (Shape ix, Elt a) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Array (ix :. Int) a) -> Acc Segments -> 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.

fold1Seg :: (Shape ix, Elt a) => (Exp a -> Exp a -> Exp a) -> Acc (Array (ix :. Int) a) -> Acc Segments -> 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.

Scan functions

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

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.

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 = (crop 0 (len - 1) res, unit (res!len))
   where
     len = shape arr
     res = scanl f e arr

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

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

 scanl1 f e arr = crop 1 len res
   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.

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\''.

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

Right-to-left variant of scanl1.

Permutations

permuteSource

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)

permuted array

-> 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. Eltents that are mapped to the magic value ignore by the permutation function are being dropped.

backpermuteSource

Arguments

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

shape of the result array

-> (Exp ix' -> Exp ix)

permutation

-> Acc (Array ix a)

permuted array

-> Acc (Array ix' a) 

Backward permutation

Stencil operations

stencilSource

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.

stencil2Source

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.

Pipelining

(>->) :: (Arrays a, Arrays b, Arrays c) => (Acc a -> Acc b) -> (Acc b -> Acc c) -> Acc a -> Acc cSource

Pipelining of two array computations.

Denotationally, we have

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

Operationally, the array computations acc1 and acc2 will not share any subcomputations, neither between each other nor with the environment. This makes them truly independent stages that only communicate by way of the result of acc1 which is being fed as an argument to acc2.

Array-level flow-control

condSource

Arguments

:: Arrays a 
=> Exp Bool

if-condition

-> Acc a

then-array

-> Acc a

else-array

-> Acc a 

An array-level if-then-else construct.

(?|) :: Arrays a => Exp Bool -> (Acc a, Acc a) -> Acc aSource

Infix version of cond.

Lifting and unlifting

class Lift e whereSource

Associated Types

type Plain e Source

Methods

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

Lift the given value into Exp. The value may already contain subexpressions in Exp.

Instances

Lift Bool 
Lift Char 
Lift Double 
Lift Float 
Lift Int 
Lift Int8 
Lift Int16 
Lift Int32 
Lift Int64 
Lift Word 
Lift Word8 
Lift Word16 
Lift Word32 
Lift Word64 
Lift () 
Lift Z 
Shape sh => Lift (Any sh) 
Lift (Exp e) 
(Lift a, Lift b, Elt (Plain a), Elt (Plain b)) => Lift (a, b) 
(Elt e, Slice (Plain ix), Lift ix) => Lift (:. ix (Exp e)) 
(Slice (Plain ix), Lift ix) => Lift (:. ix All) 
(Slice (Plain ix), Lift ix) => Lift (:. ix Int) 
(Lift a, Lift b, Lift c, Elt (Plain a), Elt (Plain b), Elt (Plain c)) => Lift (a, b, c) 
(Lift a, Lift b, Lift c, Lift d, Elt (Plain a), Elt (Plain b), Elt (Plain c), Elt (Plain d)) => Lift (a, b, c, d) 
(Lift a, Lift b, Lift c, Lift d, Lift e, Elt (Plain a), Elt (Plain b), Elt (Plain c), Elt (Plain d), Elt (Plain e)) => Lift (a, b, c, d, e) 
(Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Elt (Plain a), Elt (Plain b), Elt (Plain c), Elt (Plain d), Elt (Plain e), Elt (Plain f)) => Lift (a, b, c, d, e, f) 
(Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g, Elt (Plain a), Elt (Plain b), Elt (Plain c), Elt (Plain d), Elt (Plain e), Elt (Plain f), Elt (Plain g)) => Lift (a, b, c, d, e, f, g) 
(Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g, Lift 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 (a, b, c, d, e, f, g, h) 
(Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g, Lift h, Lift 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 (a, b, c, d, e, f, g, h, i) 

class Lift e => Unlift e whereSource

Methods

unlift :: Exp (Plain e) -> eSource

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

Instances

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

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

Lift a unary function into Exp.

lift2 :: (Unlift e1, Unlift e2, Lift 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 (Z :. Int) -> Exp (Z :. Int)Source

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

ilift2 :: (Exp Int -> Exp Int -> Exp Int) -> Exp (Z :. Int) -> Exp (Z :. Int) -> Exp (Z :. Int)Source

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

Tuple construction and destruction

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

Extract the first component of a pair.

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

Extract the second component of a pair.

curry :: (Elt a, Elt b) => (Exp (a, b) -> Exp c) -> Exp a -> Exp b -> Exp cSource

Converts an uncurried function to a curried function.

uncurry :: (Elt a, Elt b) => (Exp a -> Exp b -> Exp c) -> Exp (a, b) -> Exp cSource

Converts a curried function to a function on pairs.

Index construction and destruction

index0 :: Exp ZSource

The one index for a rank-0 array.

index1 :: Exp Int -> Exp (Z :. Int)Source

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

unindex1 :: Exp (Z :. Int) -> Exp IntSource

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

Conditional expressions

(?) :: Elt t => Exp Bool -> (Exp t, Exp t) -> Exp tSource

Conditional expression.

Array operations with a scalar result

(!) :: (Shape ix, Elt e) => Acc (Array ix e) -> Exp ix -> Exp eSource

Expression form that extracts a scalar from an array.

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

Extraction of the element in a singleton array.

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

Expression form that yields the shape of an array.

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

Expression form that yields the size of an array.

Methods of H98 classes that we need to redefine as their signatures change

(==*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp BoolSource

Equality lifted into Accelerate expressions.

(/=*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp BoolSource

Inequality lifted into Accelerate expressions.

(<*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp BoolSource

Smaller-than lifted into Accelerate expressions.

(<=*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp BoolSource

Smaller-or-equal lifted into Accelerate expressions.

(>*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp BoolSource

Greater-than lifted into Accelerate expressions.

(>=*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp BoolSource

Greater-or-equal lifted into Accelerate expressions.

max :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp tSource

Determine the maximum of two scalars.

min :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp tSource

Determine the minimum of two scalars.

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

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

shift, shiftR, shiftL :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp tSource

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

Conversions from the RealFrac class

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

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

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

Standard functions that we need to redefine as their signatures change

(&&*) :: Exp Bool -> Exp Bool -> Exp BoolSource

Conjunction

(||*) :: Exp Bool -> Exp Bool -> Exp BoolSource

Disjunction

not :: Exp Bool -> Exp BoolSource

Negation

Conversions

boolToInt :: Exp Bool -> Exp IntSource

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 bSource

General coercion from integral types

Constants

ignore :: Shape ix => Exp ixSource

Magic value identifying elements that are ignored in a forward permutation

Map-like

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.

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.

Reductions

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. The first argument needs to be an associative function to enable an efficient parallel implementation.

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.

Scans

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 => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc Segments -> Acc (Vector a)Source

Segmented version of scanl.

scanlSeg' :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc Segments -> (Acc (Vector a), Acc (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.

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

Segmented version of scanl1.

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

Segmented version of prescanl.

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

Segmented version of postscanl.

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

Segmented version of scanr.

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

Segmented version of 'scanrSeg\''.

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

Segmented version of scanr1.

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

Segmented version of prescanr.

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

Segmented version of postscanr.

Deprecated names for backwards compatibility

class Elt e => Elem e Source

Instances

Elt e => Elem e 

class Shape sh => Ix sh Source

Instances

Shape sh => Ix sh 

class Slice sh => SliceIx sh Source

Instances

Slice sh => SliceIx sh 

tuple :: Lift e => e -> Exp (Plain e)Source

untuple :: Unlift e => Exp (Plain e) -> eSource