Skip to content
Browse files

Initial version derived from gpuexp

Ignore-this: f7b7e765b8d119d0ee84d8f4c8b4c557

darcs-hash:20090704111922-6295e-aaf57d80037d7167ac85d6c3aa60923825d44a2d.gz
  • Loading branch information...
0 parents commit 835e4ff262b5573b578551070d196f1ccabd17c1 @mchakravarty mchakravarty committed
48 Data/Array/Accelerate.hs
@@ -0,0 +1,48 @@
+-- |An embedded language of accelerated array computations
+--
+-- Copyright (c) [2008..2009] Manuel M T Chakravarty, Gabriele Keller, Sean Lee
+--
+-- License: BSD3
+--
+--- Description ---------------------------------------------------------------
+--
+-- Abstract interface
+-- ~~~~~~~~~~~~~~~~~~
+-- The types representing array computations are only exported abstractly.
+-- This gives us more flexibility for later changes.
+
+module Data.Array.Accelerate (
+
+ -- * Scalar element types
+ Int, Int8, Int16, Int32, Int64, Word, Word8, Word16, Word32, Word64,
+ CShort, CUShort, CInt, CUInt, CLong, CULong, CLLong, CULLong,
+ Float, Double, CFloat, CDouble,
+ Bool, Char, CChar, CSChar, CUChar,
+
+ -- * Array data types
+ Array, Arr, DIM0, DIM1, DIM2,
+
+ -- * Array indices
+ Index(..),
+
+ -- * Abstract types of array computations
+ Exp,
+
+ -- * FIXME
+ mkVal, mkNumVal,
+
+ -- * Smart expression constructors
+ module Data.Array.Accelerate.Language,
+
+ -- * Executing array code
+-- run
+
+) where
+
+-- friends
+import Data.Array.Accelerate.Type
+import Data.Array.Accelerate.AST (Index(..))
+import Data.Array.Accelerate.Smart (Exp,
+ mkVal, mkNumVal) -- FIXME: can't we avoid that
+import Data.Array.Accelerate.Language
+--import Data.Array.Accelerate.Run
292 Data/Array/Accelerate/AST.hs
@@ -0,0 +1,292 @@
+{-# LANGUAGE GADTs #-}
+
+-- |Embedded array processing language: accelerate AST with de Bruijn indices
+--
+-- Copyright (c) [2008..2009] Manuel M T Chakravarty, Gabriele Keller, Sean Lee
+--
+-- License: BSD3
+--
+--- Description ---------------------------------------------------------------
+--
+-- Scalar versus collective operations
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- The embedded array processing language is a two-level language. It
+-- combines a language of scalar expressions and functions with a language of
+-- collective array operations. Scalar expressions are used to compute
+-- arguments for collective operations and scalar functions are used to
+-- parametrise higher-order, collective array operations. The two-level
+-- structure, in particular, ensures that collective operations cannot be
+-- parametrised with collective operations; hence, we are following a flat
+-- data-parallel model. The collective operations manipulate
+-- multi-dimensional arrays whose shape is explicitly tracked in their
+-- types. In fact, collective operations cannot produce any values other
+-- than multi-dimensional arrays; when they yield a scalar, this is in the
+-- form of a 0-dimensional, singleton array.
+--
+-- Programs
+-- ~~~~~~~~
+-- Collective array programs are monadic sequences of collective array
+-- operations. The monadic framework provides for the explicit sharing of
+-- intermediate results and orders the computations. Programs are the
+-- execution unit for array computations.
+--
+-- Functions
+-- ~~~~~~~~~
+-- The array expression language is first-order and only provides only limited
+-- control structures, to ensure that it can be efficiently executed on
+-- compute acceleration hardware, such as GPUs. To restrict functions to
+-- first-order, we separate function abstraction from the main expression
+-- type. Functions are represented using de Bruijn indices.
+--
+-- Parametric and ad-hoc polymorphism
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- The array language features paramatric polymophism (e.g., pairing and
+-- projections) as well as ad-hoc polymorphism (e.g., arithmetic
+-- operations). All ad-hoc polymorphic constructs include reified dictionaries
+-- (c.f., module `Types'). Reified dictionaries also ensure that constants
+-- (constructor `Const') are representable on compute acceleration hardware.
+--
+-- Host <-> device transfer
+-- ~~~~~~~~~~~~~~~~~~~~~~~~
+-- This is included in the array computations to enable the code generator to
+-- schedule transfers concurrently with array operations.
+
+module Data.Array.Accelerate.AST (
+
+ Comps(..), CompBinding(..), Comp(..), Index(..), Idx(..), Fun, OpenFun(..),
+ Exp, OpenExp(..), PrimConst(..), PrimFun(..),
+
+) where
+
+-- friends
+import Data.Array.Accelerate.Type
+
+
+-- |Abstract syntax of array computations
+-- -
+
+-- |A program of collective array operations is a sequence of collective array
+-- operations
+newtype Comps = Comps [CompBinding]
+ -- FIXME: we'd like conditionals, but then we need a binary tree rather than a
+ -- sequence of collective array operations
+
+-- |A binding of a collective array operation is such an operation with an
+-- apporpriate number of `Arr' binders
+--
+data CompBinding where
+ CompBinding :: CompResult a => a -> Comp a -> CompBinding
+
+-- |The various variants of collective array operations
+--
+-- * We have no fold, only scan which returns the fold result and scan array.
+-- We assume that the code generatoris clever enough to eliminate any dead
+-- code, when only one of the two values is needed.
+--
+data Comp a where
+
+ -- array inlet (triggers async host->device transfer if necessary)
+ Use :: Array dim a -> Comp (Arr dim a)
+
+ -- capture a scalar (or a tuple of scalars) in a singleton array
+ Unit :: Exp a -> Comp (Scalar a)
+
+ -- collective operations
+ --
+
+ -- Change the shape of an array without altering its contents
+ -- * precondition: size dim == size dim'
+ Reshape :: Exp dim -- ^new shape
+ -> Arr dim' a -- ^array to be reshaped
+ -> Comp (Arr dim a)
+
+ -- Replicate an array across one or more dimensions as given by the first
+ -- argument
+ Replicate :: Index dim' dim -- ^specifies new dimensions
+ -> Arr dim a -- ^data to be replicated
+ -> Comp (Arr dim' a)
+
+ -- Index a subarray out of an array; i.e., the dimensions not indexed are
+ -- returned whole
+ Index :: Arr dim a -- ^array to be indexed
+ -> Index dim dim' -- ^dimensions to indexed
+ -> Comp (Arr dim' a)
+
+ -- Pairwise combination of elements of two arrays with the same shape
+ Zip :: Arr dim a -> Arr dim b -> Comp (Arr dim (a, b))
+
+ -- Apply the given function to all elements of the given array
+ Map :: Fun (a -> b) -> Arr dim a -> Comp (Arr dim b)
+ -- FIXME: generalise to mapFold
+
+ -- Remove all elements from a linear array that do not satisfy the given
+ -- predicate
+ Filter :: Fun (a -> Bool) -> Arr DIM1 a -> Comp (Arr DIM1 a)
+
+ -- Left-to-right prescan of a linear array with a given *associative*
+ -- function and its neutral element; produces a rightmost fold value and a
+ -- linear of the same shape (the fold value would be the rightmost element
+ -- in a scan, as opposed to a prescan)
+ Scan :: Fun (a -> a -> a) -- ^combination function
+ -> Exp a -- ^default value
+ -> Arr DIM1 a -- ^linear array
+ -> Comp (Arr DIM0 a, Arr DIM1 a)
+ -- FIXME: generalise multi-dimensional scan? And/or a generalised mapScan?
+
+ -- Generalised forward permutation is characterised by a permutation
+ -- function that determines for each element of the source array where it
+ -- should go in the target; the permutation can be between arrays of varying
+ -- shape; the permutation function must be total.
+ --
+ -- The target array is initialised from an array of default values (in case
+ -- some positions in the target array are never picked by the permutation
+ -- functions). Moroever, we have a combination function (in case some
+ -- positions on the target array are picked multiple times by the
+ -- permutation functions). The combination functions needs to be
+ -- *associative* and *commutative*.
+ Permute :: Fun (a -> a -> a) -- ^combination function
+ -> Arr dim' a -- ^default values
+ -> Fun (dim -> dim') -- ^permutation function
+ -> Arr dim a -- ^linear array to permute
+ -> Comp (Arr dim' a)
+
+ -- Generalised multi-dimensional backwards permutation; the permutation can
+ -- be between arrays of varying shape; the permutation function must be total
+ Backpermute :: Exp dim' -- ^dimensions of the result
+ -> Fun (dim' -> dim) -- ^permutation function
+ -> Arr dim a -- ^source array
+ -> Comp (Arr dim' a)
+
+-- |Generalised array index, which may index only in a subset of the dimensions
+-- of a shape.
+--
+data Index initialDim projectedDim where
+ IndexNil :: Index () ()
+ IndexAll :: Index init proj -> Index (init, Int) (proj, Int)
+ IndexFixed :: Exp Int -> Index init proj -> Index (init, Int) proj
+
+-- De Bruijn variable index projecting a specific type from a type
+-- environment. Type envionments are nested pairs (..((), t1), t2, ..., tn).
+--
+data Idx env t where
+ ZeroIdx :: Idx (env, t) t
+ SuccIdx :: Idx env t -> Idx (env, s) t
+
+-- |Closed function (may be nullary)
+--
+type Fun fun = OpenFun () fun
+
+-- |Function abstraction
+--
+data OpenFun env t where
+ Body :: OpenExp env t -> OpenFun env t
+ Lam :: OpenFun (env, a) t -> OpenFun env (a -> t)
+
+-- Closed expression
+--
+type Exp t = OpenExp () t
+
+-- |Open expressions using de Bruijn indices for variables ranging over tuples
+-- of scalars; they never produce an array. All code, except Cond, is
+-- evaluated eagerly. N-tuples are represented as a nested pairs.
+--
+data OpenExp env t where
+
+ -- |Variable index
+ Var :: TupleType t -> Idx env t -> OpenExp env t
+
+ -- |Constant values
+ Const :: ScalarType t -> t -> OpenExp env t
+
+ -- |Tuples
+ Pair :: OpenExp env s -> OpenExp env t -> OpenExp env (s, t)
+ Fst :: OpenExp env (s, t) -> OpenExp env s
+ Snd :: OpenExp env (s, t) -> OpenExp env t
+
+ -- |Conditional expression (non-strict in 2nd and 3rd argument)
+ Cond :: OpenExp env Bool -> OpenExp env t -> OpenExp env t
+ -> OpenExp env t
+
+ -- |Primitive constants
+ PrimConst :: PrimConst t -> OpenExp env t
+
+ -- |Primitive scalar operations
+ PrimApp :: PrimFun (a -> r) -> OpenExp env a -> OpenExp env r
+
+ -- |Project a single scalar from an array
+ IndexScalar :: Arr dim t -> OpenExp env dim -> OpenExp env t
+
+ -- |Array shape
+ Shape :: Arr dim e -> OpenExp env dim
+
+-- |Primitive GPU constants
+--
+data PrimConst ty where
+
+ -- constants from Bounded
+ PrimMinBound :: BoundedType a -> PrimConst a
+ PrimMaxBound :: BoundedType a -> PrimConst a
+
+ -- constant from Floating
+ PrimPi :: FloatingType a -> PrimConst a
+
+-- |Primitive GPU operations
+--
+data PrimFun sig where
+
+ -- operators from Num
+ PrimAdd :: NumType a -> PrimFun ((a, a) -> a)
+ PrimSub :: NumType a -> PrimFun ((a, a) -> a)
+ PrimMul :: NumType a -> PrimFun ((a, a) -> a)
+ PrimNeg :: NumType a -> PrimFun (a -> a)
+ PrimAbs :: NumType a -> PrimFun (a -> a)
+ PrimSig :: NumType a -> PrimFun (a -> a)
+
+ -- operators from Integral & Bits
+ PrimQuot :: IntegralType a -> PrimFun ((a, a) -> a)
+ PrimRem :: IntegralType a -> PrimFun ((a, a) -> a)
+ PrimIDiv :: IntegralType a -> PrimFun ((a, a) -> a)
+ PrimMod :: IntegralType a -> PrimFun ((a, a) -> a)
+ PrimBAnd :: IntegralType a -> PrimFun ((a, a) -> a)
+ PrimBOr :: IntegralType a -> PrimFun ((a, a) -> a)
+ PrimBXor :: IntegralType a -> PrimFun ((a, a) -> a)
+ PrimBNot :: IntegralType a -> PrimFun (a -> a)
+ -- FIXME: add shifts
+
+ -- operators from Fractional, Floating, RealFrac & RealFloat
+ PrimFDiv :: FloatingType a -> PrimFun ((a, a) -> a)
+ PrimRecip :: FloatingType a -> PrimFun (a -> a)
+ -- FIXME: add operations from Floating, RealFrac & RealFloat
+
+ -- relational and equality operators
+ PrimLt :: ScalarType a -> PrimFun ((a, a) -> Bool)
+ PrimGt :: ScalarType a -> PrimFun ((a, a) -> Bool)
+ PrimLtEq :: ScalarType a -> PrimFun ((a, a) -> Bool)
+ PrimGtEq :: ScalarType a -> PrimFun ((a, a) -> Bool)
+ PrimEq :: ScalarType a -> PrimFun ((a, a) -> Bool)
+ PrimNEq :: ScalarType a -> PrimFun ((a, a) -> Bool)
+ PrimMax :: ScalarType a -> PrimFun ((a, a) -> a )
+ PrimMin :: ScalarType a -> PrimFun ((a, a) -> a )
+
+ -- logical operators
+ PrimLAnd :: PrimFun ((Bool, Bool) -> Bool)
+ PrimLOr :: PrimFun ((Bool, Bool) -> Bool)
+ PrimLNot :: PrimFun (Bool -> Bool)
+
+ -- character conversions
+ PrimOrd :: PrimFun (Char -> Int)
+ PrimChr :: PrimFun (Int -> Char)
+ -- FIXME: use IntegralType?
+
+ -- floating point conversions
+ PrimRoundFloatInt :: PrimFun (Float -> Int)
+ PrimTruncFloatInt :: PrimFun (Float -> Int)
+ PrimIntFloat :: PrimFun (Int -> Float)
+ -- FIXME: variants for other integer types (and also for Double)
+ -- ALSO: need to use overloading
+
+ -- FIXME: conversions between various integer types
+
+ -- FIXME: what do we want to do about Enum? succ and pred are only
+ -- moderatly useful without user-defined enumerations, but we want
+ -- the range constructs for arrays (but that's not scalar primitives)
300 Data/Array/Accelerate/Language.hs
@@ -0,0 +1,300 @@
+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+
+-- |Embedded array processing language: user visible language
+--
+-- Copyright (c) 2009 Manuel M T Chakravarty, Gabriele Keller, Sean Lee
+--
+-- License: BSD3
+--
+--- Description ---------------------------------------------------------------
+--
+-- We use the dictionary view of overloaded operations (such as arithmetic and
+-- bit manipulation) to reify such expressions. With non-overloaded
+-- operations (such as, the logical connectives) and partially overloaded
+-- operations (such as comparisons), we use the standard operator names with a
+-- '*' attached. We keep the standard alphanumeric names as they can be
+-- easily qualified.
+
+module Data.Array.Accelerate.Language (
+
+ -- * Array processing computation monad
+ AP, APstate, runAPU,
+
+ -- * Array introduction
+ use, unit,
+
+ -- * Shape manipulation
+ reshape,
+
+ -- * Collective array operations
+ replicate, zip, map, zipWith, filter, scan, fold, permute, backpermute,
+
+ -- * Instances of Bounded, Enum, Eq, Ord, Bits, Num, Real, Floating,
+ -- Fractional, RealFrac, RealFloat
+
+ -- * Methods of H98 classes that we need to redefine as their signatures
+ -- change
+ (==*), (/=*), (<*), (<=*), (>*), (>=*), max, min,
+
+ -- * Standard functions that we need to redefine as their signatures change
+ (&&*), (||*), not
+
+) where
+
+-- standard libraries
+import Data.Bits
+import Control.Monad.State
+
+-- avoid clashes with Prelude functions
+import Prelude hiding (replicate, zip, map, zipWith, filter, max, min, not)
+import qualified Prelude
+
+-- friends
+import Data.Array.Accelerate.Type
+import Data.Array.Accelerate.AST hiding (Exp, OpenExp(..))
+import Data.Array.Accelerate.Smart
+import Data.Array.Accelerate.Pretty
+
+
+infixr 2 ||*
+infixr 3 &&*
+infix 4 ==*, /=*, <*, <=*, >*, >=*
+infixl 9 !
+
+
+-- |Monad of collective operations
+-- -------------------------------
+
+-- |Array processing computations as a state transformer
+--
+type AP a = State APstate a
+
+data APstate = APstate
+ { comps :: Comps -- the program so far (reversed list)
+ , sym :: Int -- next unique variable name
+ }
+
+unComps :: APstate -> [CompBinding]
+unComps s = case comps s of Comps cs -> cs
+
+initialAPstate :: APstate
+initialAPstate = APstate (Comps []) 0
+
+runAPU :: AP a -> Comps
+runAPU = reverseComps . comps . flip execState initialAPstate
+ where
+ reverseComps (Comps cs) = Comps (reverse cs)
+
+-- Obtain a unique variable name; it's unique in the AP computation
+--
+genSym :: AP String
+genSym
+ = do
+ n <- gets sym
+ modify $ \s -> s {sym = succ (sym s)}
+ return $ "a" ++ show n
+
+-- Obtain a unique array identifier at a given element type; it's unique in
+-- the AP computation
+--
+genArr :: TupleType e -> AP (Arr dim e)
+genArr ty
+ = do
+ name <- genSym
+ return $ Arr ty name
+
+-- Add a collective operation to the list in the monad state
+--
+pushComp :: CompBinding -> AP ()
+pushComp comp = modify $ \s -> s {comps = Comps $ comp : unComps s}
+
+wrapComp :: TupleType e -> Comp (Arr dim e) -> AP (Arr dim e)
+wrapComp ty comp
+ = do
+ arr <- genArr ty
+ pushComp $ arr `CompBinding` comp
+ return arr
+
+wrapComp2 :: TupleType e1 -> TupleType e2 -> Comp (Arr dim1 e1, Arr dim2 e2)
+ -> AP (Arr dim1 e1, Arr dim2 e2)
+wrapComp2 ty1 ty2 comp
+ = do
+ arr1 <- genArr ty1
+ arr2 <- genArr ty2
+ pushComp $ (arr1, arr2) `CompBinding` comp
+ return (arr1, arr2)
+
+
+-- |Collective operations
+-- ----------------------
+
+use :: IsTuple e => Array dim e -> AP (Arr dim e)
+use array = wrapComp tupleType (Use array)
+
+unit :: IsTuple e => Exp e -> AP (Scalar e)
+unit e = wrapComp tupleType (Unit (convertExp e))
+
+reshape :: IsTuple e => Exp dim -> Arr dim' e -> AP (Arr dim e)
+reshape e arr = wrapComp tupleType (Reshape (convertExp e) arr)
+
+replicate :: IsTuple e => Index dim' dim -> Arr dim e -> AP (Arr dim' e)
+replicate ix arr = wrapComp tupleType (Replicate ix arr)
+ -- FIXME: need nice syntax for generalised indicies
+
+(!) :: IsTuple e => Arr dim e -> Index dim dim' -> AP (Arr dim' e)
+arr ! ix = wrapComp tupleType (Index arr ix)
+
+zip :: IsTuple (a, b) => Arr dim a -> Arr dim b -> AP (Arr dim (a, b))
+zip arr1 arr2 = wrapComp tupleType (Zip arr1 arr2)
+
+map :: (IsTuple a, IsTuple b)
+ => (Exp a -> Exp b) -> Arr dim a -> AP (Arr dim b)
+map f arr = wrapComp tupleType (Map (convertFun1 f) arr)
+
+zipWith :: (IsTuple (a, b), IsTuple c)
+ => (Exp a -> Exp b -> Exp c) -> Arr dim a -> Arr dim b -> AP (Arr dim c)
+zipWith f arr1 arr2
+ = do
+ let f' = \xy -> f (Fst xy) (Snd xy)
+ arr' <- genArr tupleType
+ pushComp $ arr' `CompBinding` (Zip arr1 arr2)
+ arr <- genArr tupleType
+ pushComp $ arr `CompBinding` (Map (convertFun1 f') arr')
+ return arr
+
+filter :: IsTuple a => (Exp a -> Exp Bool) -> Arr DIM1 a -> AP (Arr DIM1 a)
+filter p arr = wrapComp tupleType (Filter (convertFun1 p) arr)
+ -- FIXME: we want the argument of the mapped function to be a tuple, too
+
+scan :: IsTuple a
+ => (Exp a -> Exp a -> Exp a) -> Exp a -> Arr DIM1 a
+ -> AP (Scalar a, Arr DIM1 a)
+scan f e arr = wrapComp2 tupleType tupleType $
+ (Scan (convertFun2 f) (convertExp e) arr)
+
+fold :: IsTuple a
+ => (Exp a -> Exp a -> Exp a) -> Exp a -> Arr DIM1 a -> AP (Scalar a)
+fold f e arr
+ = do
+ (r, _) <- scan f e arr
+ return r
+
+permute :: (IsTuple a, IsTuple dim, IsTuple dim')
+ => (Exp a -> Exp a -> Exp a) -> Arr dim' a -> (Exp dim -> Exp dim')
+ -> Arr dim a -> AP (Arr dim' a)
+permute f dftArr perm arr
+ = wrapComp tupleType $ Permute (convertFun2 f) dftArr (convertFun1 perm) arr
+
+backpermute :: (IsTuple a , IsTuple dim, IsTuple dim')
+ => Exp dim' -> (Exp dim' -> Exp dim) -> Arr dim a -> AP (Arr dim' a)
+backpermute newDim perm arr
+ = wrapComp tupleType $ Backpermute (convertExp newDim) (convertFun1 perm) arr
+
+
+-- |Instances of all relevant H98 classes
+-- --------------------------------------
+
+instance IsBounded t => Bounded (Exp t) where
+ minBound = mkMinBound
+ maxBound = mkMaxBound
+
+instance IsScalar t => Enum (Exp t)
+-- succ = mkSucc
+-- pred = mkPred
+ -- FIXME: ops
+
+instance IsScalar t => Prelude.Eq (Exp t)
+ -- FIXME: instance makes no sense with standard signatures
+
+instance IsScalar t => Prelude.Ord (Exp t)
+ -- FIXME: instance makes no sense with standard signatures
+
+instance (IsNum t, IsIntegral t) => Bits (Exp t) where
+ (.&.) = mkBAnd
+ (.|.) = mkBOr
+ xor = mkBXor
+ complement = mkBNot
+ -- FIXME: argh, the rest have fixed types in their signatures
+
+instance IsNum t => Num (Exp t) where
+ (+) = mkAdd
+ (-) = mkSub
+ (*) = mkMul
+ negate = mkNeg
+ abs = mkAbs
+ signum = mkSig
+ fromInteger = mkNumVal . fromInteger
+
+instance IsNum t => Real (Exp t)
+ -- FIXME: Why did we include this class? We won't need `toRational' until
+ -- we support rational numbers in AP computations.
+
+instance IsIntegral t => Integral (Exp t) where
+ quot = mkQuot
+ rem = mkRem
+ div = mkIDiv
+ mod = mkMod
+-- quotRem =
+-- divMod =
+-- toInteger = -- makes no sense
+
+instance IsFloating t => Floating (Exp t) where
+ pi = mkPi
+ -- FIXME: add other ops
+
+instance IsFloating t => Fractional (Exp t) where
+ (/) = mkFDiv
+ recip = mkRecip
+ fromRational = mkNumVal . fromRational
+ -- FIXME: add other ops
+
+instance IsFloating t => RealFrac (Exp t)
+ -- FIXME: add ops
+
+instance IsFloating t => RealFloat (Exp t)
+ -- FIXME: add ops
+
+
+-- |Methods from H98 classes, where we need other signatures
+-- ---------------------------------------------------------
+
+(==*) :: IsScalar t => Exp t -> Exp t -> Exp Bool
+(==*) = mkEq
+
+(/=*) :: IsScalar t => Exp t -> Exp t -> Exp Bool
+(/=*) = mkNEq
+
+-- compare :: a -> a -> Ordering -- we have no enumerations at the moment
+-- compare = ...
+
+(<*) :: IsScalar t => Exp t -> Exp t -> Exp Bool
+(<*) = mkLt
+
+(>=*) :: IsScalar t => Exp t -> Exp t -> Exp Bool
+(>=*) = mkGtEq
+
+(>*) :: IsScalar t => Exp t -> Exp t -> Exp Bool
+(>*) = mkGt
+
+(<=*) :: IsScalar t => Exp t -> Exp t -> Exp Bool
+(<=*) = mkLtEq
+
+max :: IsScalar t => Exp t -> Exp t -> Exp t
+max = mkMax
+
+min :: IsScalar t => Exp t -> Exp t -> Exp t
+min = mkMin
+
+
+-- |Non-overloaded standard functions, where we need other signatures
+-- ------------------------------------------------------------------
+
+(&&*) :: Exp Bool -> Exp Bool -> Exp Bool
+(&&*) = mkLAnd
+
+(||*) :: Exp Bool -> Exp Bool -> Exp Bool
+(||*) = mkLOr
+
+not :: Exp Bool -> Exp Bool
+not = mkLNot
+
229 Data/Array/Accelerate/Pretty.hs
@@ -0,0 +1,229 @@
+{-# LANGUAGE GADTs, FlexibleInstances, PatternGuards, TypeOperators #-}
+
+-- |Embedded array processing language: pretty printing
+--
+-- Copyright (c) 2009 Manuel M T Chakravarty, Gabriele Keller, Sean Lee
+--
+-- License: BSD3
+--
+--- Description ---------------------------------------------------------------
+--
+
+module Data.Array.Accelerate.Pretty (
+
+ -- * Instances of Show
+
+) where
+
+-- standard libraries
+import Text.PrettyPrint
+
+-- friends
+import Data.Array.Accelerate.Type
+import Data.Array.Accelerate.AST
+
+
+-- |Show instances
+-- ---------------
+
+instance Show Comps where
+ show cs = render $ prettyComps cs
+
+instance Show CompBinding where
+ show c = render $ prettyCompBinding c
+
+instance Show (Comp a) where
+ show c = render $ prettyComp c
+
+instance Show (OpenFun env f) where
+ show f = render $ prettyFun f
+
+instance Show (OpenExp env t) where
+ show e = render $ prettyExp noParens e
+
+
+-- |Pretty printing
+-- ----------------
+
+-- |Pretty print a sequence of collective operations.
+--
+prettyComps :: Comps -> Doc
+prettyComps (Comps []) = text "<empty>"
+prettyComps (Comps [c]) = prettyCompReturn c
+prettyComps (Comps cs) =
+ hang (text "do") 2 $
+ vcat (map prettyCompBinding binds ++ [prettyCompReturn ret])
+ where
+ binds = init cs
+ ret = last cs
+
+-- |Pretty print just the collective operation of a binding.
+--
+prettyCompReturn :: CompBinding -> Doc
+prettyCompReturn (CompBinding _ coll) = prettyComp coll
+
+-- |Pretty print a binding of a collective operation.
+--
+prettyCompBinding :: CompBinding -> Doc
+prettyCompBinding (CompBinding r coll)
+ = prettyVarNames (strings r) <+> text "<-" <+> prettyComp coll
+ where
+ prettyVarNames [] = text "()"
+ prettyVarNames [name] = text name
+ prettyVarNames names =
+ parens . hsep . punctuate (char ',') . map text $ names
+
+-- |Pretty print a collective array computation.
+--
+prettyComp :: Comp a -> Doc
+prettyComp (Use arr) = text "use" <+> prettyArray arr
+prettyComp (Unit e) = text "unit" <+> prettyExp parens e
+prettyComp (Reshape sh arr)
+ = text "reshape" <+> prettyExp parens sh <+> prettyArr arr
+prettyComp (Replicate ix arr)
+ = text "replicate" <+> prettyIndex ix <+> prettyArr arr
+prettyComp (Index arr ix)
+ = prettyArr arr <> char '!' <> prettyIndex ix
+prettyComp (Zip arr1 arr2) = text "zip" <+> prettyArr arr1 <+> prettyArr arr2
+prettyComp (Map f arr)
+ = text "map" <+> parens (prettyFun f) <+> prettyArr arr
+prettyComp (Filter p arr)
+ = text "filter" <+> parens (prettyFun p) <+> prettyArr arr
+prettyComp (Scan f e arr)
+ = text "scan" <+> parens (prettyFun f) <+> prettyExp parens e <+>
+ prettyArr arr
+prettyComp (Permute f dfts p arr)
+ = text "permute" <+> parens (prettyFun f) <+> prettyArr dfts <+>
+ parens (prettyFun p) <+> prettyArr arr
+prettyComp (Backpermute sh p arr)
+ = text "backpermute" <+> prettyExp parens sh <+> parens (prettyFun p) <+>
+ prettyArr arr
+
+-- |Pretty print a function over scalar expressions.
+--
+prettyFun :: OpenFun env fun -> Doc
+prettyFun fun =
+ let (n, bodyDoc) = count fun
+ in
+ char '\\' <> hsep [text $ "a" ++ show idx | idx <- [0..n]] <+> text "->" <+>
+ bodyDoc
+ where
+ count :: OpenFun env fun -> (Int, Doc)
+ count (Body body) = (-1, prettyExp noParens body)
+ count (Lam fun) = let (n, body) = count fun in (1 + n, body)
+
+-- |Pretty print an expression.
+--
+-- * Apply the wrapping combinator (1st argument) to any compound expressions.
+--
+prettyExp :: (Doc -> Doc) -> OpenExp env t -> Doc
+--prettyExp wrap (Arg ty) = wrap $ text "arg ::" <+> prettyAnyType ty
+prettyExp wrap (Var _ idx) = text $ "a" ++ show (count idx)
+ where
+ count :: Idx env t -> Int
+ count ZeroIdx = 0
+ count (SuccIdx idx) = 1 + count idx
+prettyExp _ (Const ty v) = text $ runShow ty v
+prettyExp _ (Pair e1 e2) = prettyTuple (Pair e1 e2)
+prettyExp wrap (Fst e) = wrap $ text "fst" <+> prettyExp parens e
+prettyExp wrap (Snd e) = wrap $ text "snd" <+> prettyExp parens e
+prettyExp wrap (Cond c t e)
+ = wrap $ sep [prettyExp parens c <+> char '?', prettyExp noParens (Pair t e)]
+prettyExp _ (PrimConst a) = prettyConst a
+prettyExp wrap (PrimApp p a) = wrap $ prettyPrim p <+> prettyExp parens a
+prettyExp wrap (IndexScalar a i)
+ = wrap $ cat [prettyArr a, char '!', prettyExp parens i]
+prettyExp wrap (Shape a) = wrap $ text "shape" <+> prettyArr a
+
+-- |Pretty print nested pairs as a proper tuple.
+--
+prettyTuple :: OpenExp env t -> Doc
+prettyTuple e = parens $ sep (map (<> comma) (init es) ++ [last es])
+ where
+ es = collect e
+ --
+ collect :: OpenExp env t -> [Doc]
+ collect (Pair e1 e2) = collect e1 ++ collect e2
+ collect e = [prettyExp noParens e]
+
+-- |Pretty print a primitive constant
+--
+prettyConst :: PrimConst a -> Doc
+prettyConst (PrimMinBound _) = text "minBound"
+prettyConst (PrimMaxBound _) = text "maxBound"
+prettyConst (PrimPi _) = text "pi"
+
+-- |Pretty print a primitive operation
+--
+prettyPrim :: PrimFun a -> Doc
+prettyPrim (PrimAdd _) = text "(+)"
+prettyPrim (PrimSub _) = text "(-)"
+prettyPrim (PrimMul _) = text "(*)"
+prettyPrim (PrimNeg _) = text "negate"
+prettyPrim (PrimAbs _) = text "abs"
+prettyPrim (PrimSig _) = text "signum"
+prettyPrim (PrimQuot _) = text "quot"
+prettyPrim (PrimRem _) = text "rem"
+prettyPrim (PrimIDiv _) = text "div"
+prettyPrim (PrimMod _) = text "mod"
+prettyPrim (PrimBAnd _) = text "(.&.)"
+prettyPrim (PrimBOr _) = text "(.|.)"
+prettyPrim (PrimBXor _) = text "xor"
+prettyPrim (PrimBNot _) = text "complement"
+prettyPrim (PrimFDiv _) = text "(/)"
+prettyPrim (PrimRecip _) = text "recip"
+prettyPrim (PrimLt _) = text "(<*)"
+prettyPrim (PrimGt _) = text "(>*)"
+prettyPrim (PrimLtEq _) = text "(<=*)"
+prettyPrim (PrimGtEq _) = text "(>=*)"
+prettyPrim (PrimEq _) = text "(==*)"
+prettyPrim (PrimNEq _) = text "(/=*)"
+prettyPrim (PrimMax _) = text "max"
+prettyPrim (PrimMin _) = text "min"
+prettyPrim PrimLAnd = text "&&*"
+prettyPrim PrimLOr = text "||*"
+prettyPrim PrimLNot = text "not"
+
+-- |Pretty print type
+--
+prettyAnyType :: ScalarType a -> Doc
+prettyAnyType ty = text $ show ty
+
+-- |Pretty print the identification code of an APU array
+--
+prettyArray :: Array dim a -> Doc
+prettyArray arr = text $ arrayId arr
+
+-- |Pretty print a generalised array index
+--
+prettyIndex :: Index initial projected -> Doc
+prettyIndex = parens . hsep . punctuate (char ',') . prettyIxs
+ where
+ prettyIxs :: Index initial projected -> [Doc]
+ prettyIxs IndexNil = [empty]
+ prettyIxs (IndexAll ixs) = char '.' : prettyIxs ixs
+ prettyIxs (IndexFixed e ixs) = prettyExp noParens e : prettyIxs ixs
+
+-- |Pretty print the identification of an array representation in collective code
+--
+prettyArr :: Arr dim a -> Doc
+prettyArr (Arr _ str) = text str
+
+-- |Auxilliary pretty printing combinators
+-- -
+
+noParens :: Doc -> Doc
+noParens = id
+
+-- |Auxilliary dictionary operations
+-- -
+
+-- |Show scalar values
+--
+runShow :: ScalarType a -> (a -> String)
+runShow (NumScalarType (IntegralNumType ty))
+ | IntegralDict <- integralDict ty = show
+runShow (NumScalarType (FloatingNumType ty))
+ | FloatingDict <- floatingDict ty = show
+runShow (NonNumScalarType ty)
+ | NonNumDict <- nonNumDict ty = show
231 Data/Array/Accelerate/Smart.hs
@@ -0,0 +1,231 @@
+{-# LANGUAGE GADTs, ScopedTypeVariables, FlexibleContexts #-}
+
+-- |Embedded array processing language: smart expression constructors
+--
+-- Copyright (c) [2008..2009] Manuel M T Chakravarty, Gabriele Keller, Sean Lee
+--
+-- License: BSD3
+--
+--- Description ---------------------------------------------------------------
+--
+-- This modules defines the the user-visible embedded language using more
+-- convenient higher-order abstract syntax (instead of de Bruijn indices).
+-- Moreover, it defines smart constructors to construct programs.
+
+module Data.Array.Accelerate.Smart (
+
+ -- * HOAS AST
+ Exp(..), convertExp, convertFun1, convertFun2,
+
+ -- * Constructors for literals
+ mkVal, mkNumVal,
+
+ -- * Constructors for constants
+ mkMinBound, mkMaxBound, mkPi,
+
+ -- * Constructors for primitive functions
+ mkAdd, mkSub, mkMul, mkNeg, mkAbs, mkSig, mkQuot, mkRem, mkIDiv, mkMod,
+ mkBAnd, mkBOr, mkBXor, mkBNot, mkFDiv, mkRecip, mkLt, mkGt, mkLtEq, mkGtEq,
+ mkEq, mkNEq, mkMax, mkMin, mkLAnd, mkLOr, mkLNot,
+
+) where
+
+-- standard library
+import Data.Maybe
+import Data.Typeable
+
+-- friends
+import Data.Array.Accelerate.Type
+import Data.Array.Accelerate.AST hiding (Exp, OpenExp(..))
+import qualified Data.Array.Accelerate.AST as AST
+import Data.Array.Accelerate.Pretty
+import Data.Array.Accelerate.Typeable
+
+
+-- |HOAS AST
+-- -
+
+-- HOAS expressions mirror the constructors of `AST.OpenExp', but with the
+-- `Tag' constructor instead of variables in the form of de Bruijn indices.
+--
+data Exp t where
+ -- Tag used during the conversion to de Bruijn indices
+ Tag :: Typeable1 (Idx env) => TupleType t -> Idx env t -> Exp t
+
+ -- All the same constructors as `AST.OpenExp'
+ Const :: ScalarType t -> t -> Exp t
+ Pair :: Exp s -> Exp t -> Exp (s, t)
+ Fst :: Exp (s, t) -> Exp s
+ Snd :: Exp (s, t) -> Exp t
+ Cond :: Exp Bool -> Exp t -> Exp t -> Exp t
+ PrimConst :: PrimConst t -> Exp t
+ PrimApp :: PrimFun (a -> r) -> Exp a -> Exp r
+ IndexScalar :: Arr dim t -> Exp dim -> Exp t
+ Shape :: Arr dim e -> Exp dim
+
+
+-- |Conversion from HOAS to de Bruijn AST
+-- -
+
+-- |Convert an open expression
+--
+convertExp :: Typeable env => Exp t -> AST.OpenExp env t
+convertExp (Tag ty idx) = AST.Var ty (fromJust (cast1 idx))
+ -- can't go wrong unless the library is wrong!
+convertExp (Const ty v) = AST.Const ty v
+convertExp (Pair e1 e2) = AST.Pair (convertExp e1) (convertExp e2)
+convertExp (Fst e) = AST.Fst (convertExp e)
+convertExp (Snd e) = AST.Snd (convertExp e)
+convertExp (Cond e1 e2 e3) = AST.Cond (convertExp e1) (convertExp e2)
+ (convertExp e3)
+convertExp (PrimConst c) = AST.PrimConst c
+convertExp (PrimApp p e) = AST.PrimApp p (convertExp e)
+convertExp (IndexScalar a e) = AST.IndexScalar a (convertExp e)
+convertExp (Shape a) = AST.Shape a
+
+-- |Convert a unary functions
+--
+convertFun1 :: forall a b. (Typeable a, IsTuple a)
+ => (Exp a -> Exp b) -> AST.Fun (a -> b)
+convertFun1 f = Lam (Body openF)
+ where
+ a = Tag tupleType (ZeroIdx :: Idx ((), a) a)
+ openF = convertExp (f a)
+
+-- |Convert a binary functions
+--
+convertFun2 :: forall a b c. (Typeable a, IsTuple a, Typeable b, IsTuple b)
+ => (Exp a -> Exp b -> Exp c) -> AST.Fun (a -> b -> c)
+convertFun2 f = Lam (Lam (Body openF))
+ where
+ a = Tag tupleType (SuccIdx ZeroIdx :: Idx (((), a), b) a)
+ b = Tag tupleType (ZeroIdx :: Idx (((), a), b) b)
+ openF = convertExp (f a b)
+
+instance Show (Exp t) where
+ show e = show (convertExp e :: AST.OpenExp () t)
+
+
+-- |Smart constructors to construct HOAS AST expressions
+-- -
+
+-- |Smart constructor for literals
+-- -
+
+mkVal :: IsScalar t => t -> Exp t
+mkVal = Const scalarType
+
+mkNumVal :: IsNum t => t -> Exp t
+mkNumVal = Const (NumScalarType numType)
+
+-- |Smart constructor for constants
+-- -
+
+mkMinBound :: IsBounded t => Exp t
+mkMinBound = PrimConst (PrimMinBound boundedType)
+
+mkMaxBound :: IsBounded t => Exp t
+mkMaxBound = PrimConst (PrimMaxBound boundedType)
+
+mkPi :: IsFloating r => Exp r
+mkPi = PrimConst (PrimPi floatingType)
+
+-- |Smart constructors for primitive applications
+-- -
+
+-- Operators from Num
+
+mkAdd :: IsNum t => Exp t -> Exp t -> Exp t
+mkAdd x y = PrimAdd numType `PrimApp` (x `Pair` y)
+
+mkSub :: IsNum t => Exp t -> Exp t -> Exp t
+mkSub x y = PrimSub numType `PrimApp` (x `Pair` y)
+
+mkMul :: IsNum t => Exp t -> Exp t -> Exp t
+mkMul x y = PrimMul numType `PrimApp` (x `Pair` y)
+
+mkNeg :: IsNum t => Exp t -> Exp t
+mkNeg x = PrimNeg numType `PrimApp` x
+
+mkAbs :: IsNum t => Exp t -> Exp t
+mkAbs x = PrimAbs numType `PrimApp` x
+
+mkSig :: IsNum t => Exp t -> Exp t
+mkSig x = PrimSig numType `PrimApp` x
+
+-- Operators from Integral & Bits
+
+mkQuot :: IsIntegral t => Exp t -> Exp t -> Exp t
+mkQuot x y = PrimQuot integralType `PrimApp` (x `Pair` y)
+
+mkRem :: IsIntegral t => Exp t -> Exp t -> Exp t
+mkRem x y = PrimRem integralType `PrimApp` (x `Pair` y)
+
+mkIDiv :: IsIntegral t => Exp t -> Exp t -> Exp t
+mkIDiv x y = PrimIDiv integralType `PrimApp` (x `Pair` y)
+
+mkMod :: IsIntegral t => Exp t -> Exp t -> Exp t
+mkMod x y = PrimMod integralType `PrimApp` (x `Pair` y)
+
+mkBAnd :: IsIntegral t => Exp t -> Exp t -> Exp t
+mkBAnd x y = PrimBAnd integralType `PrimApp` (x `Pair` y)
+
+mkBOr :: IsIntegral t => Exp t -> Exp t -> Exp t
+mkBOr x y = PrimBOr integralType `PrimApp` (x `Pair` y)
+
+mkBXor :: IsIntegral t => Exp t -> Exp t -> Exp t
+mkBXor x y = PrimBXor integralType `PrimApp` (x `Pair` y)
+
+mkBNot :: IsIntegral t => Exp t -> Exp t
+mkBNot x = PrimBNot integralType `PrimApp` x
+ -- FIXME: add shifts
+
+-- Operators from Fractional, Floating, RealFrac & RealFloat
+
+mkFDiv :: IsFloating t => Exp t -> Exp t -> Exp t
+mkFDiv x y = PrimFDiv floatingType `PrimApp` (x `Pair` y)
+
+mkRecip :: IsFloating t => Exp t -> Exp t
+mkRecip x = PrimRecip floatingType `PrimApp` x
+ -- FIXME: add operations from Floating, RealFrac & RealFloat
+
+-- Relational and equality operators
+
+mkLt :: IsScalar t => Exp t -> Exp t -> Exp Bool
+mkLt x y = PrimLt scalarType `PrimApp` (x `Pair` y)
+
+mkGt :: IsScalar t => Exp t -> Exp t -> Exp Bool
+mkGt x y = PrimGt scalarType `PrimApp` (x `Pair` y)
+
+mkLtEq :: IsScalar t => Exp t -> Exp t -> Exp Bool
+mkLtEq x y = PrimLtEq scalarType `PrimApp` (x `Pair` y)
+
+mkGtEq :: IsScalar t => Exp t -> Exp t -> Exp Bool
+mkGtEq x y = PrimGtEq scalarType `PrimApp` (x `Pair` y)
+
+mkEq :: IsScalar t => Exp t -> Exp t -> Exp Bool
+mkEq x y = PrimEq scalarType `PrimApp` (x `Pair` y)
+
+mkNEq :: IsScalar t => Exp t -> Exp t -> Exp Bool
+mkNEq x y = PrimLt scalarType `PrimApp` (x `Pair` y)
+
+mkMax :: IsScalar t => Exp t -> Exp t -> Exp t
+mkMax x y = PrimMax scalarType `PrimApp` (x `Pair` y)
+
+mkMin :: IsScalar t => Exp t -> Exp t -> Exp t
+mkMin x y = PrimMin scalarType `PrimApp` (x `Pair` y)
+
+-- Logical operators
+
+mkLAnd :: Exp Bool -> Exp Bool -> Exp Bool
+mkLAnd x y = PrimLAnd `PrimApp` (x `Pair` y)
+
+mkLOr :: Exp Bool -> Exp Bool -> Exp Bool
+mkLOr x y = PrimLOr `PrimApp` (x `Pair` y)
+
+mkLNot :: Exp Bool -> Exp Bool
+mkLNot x = PrimLNot `PrimApp` x
+
+-- FIXME: Character conversions
+
+-- FIXME: Numeric conversions
731 Data/Array/Accelerate/Type.hs
@@ -0,0 +1,731 @@
+{-# LANGUAGE GADTs, TypeFamilies, FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+ -- nothing undecidable here; this is for `instance IsScalar a => IsTuple a'
+
+-- |Embedded array processing language: data types
+--
+-- Copyright (c) [2008..2009] Manuel M T Chakravarty, Gabriele Keller, Sean Lee
+--
+-- License: BSD3
+--
+--- Description ---------------------------------------------------------------
+--
+-- Scalar types supported in array computations
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Integral types: Int, Int8, Int16, Int32, Int64, Word, Word8, Word16, Word32,
+-- Word64, CShort, CUShort, CInt, CUInt, CLong, CULong, CLLong, CULLong
+--
+-- Floating types: Float, Double, CFloat, CDouble
+--
+-- Non-numeric types: Bool, Char, CChar, CSChar, CUChar
+--
+-- `Int' has the same bitwidth as in plain Haskell computations, and `Float'
+-- and `Double' represent IEEE single and double precision floating point
+-- numbers, respectively.
+
+module Data.Array.Accelerate.Type (
+ module Data.Int,
+ module Data.Word,
+ module Foreign.C.Types,
+ module Data.Array.Accelerate.Type
+) where
+
+-- standard libraries
+import Data.Bits
+import Data.Int
+import Data.Typeable
+import Data.Word
+import Foreign.C.Types (
+ CChar, CSChar, CUChar, CShort, CUShort, CInt, CUInt, CLong, CULong,
+ CLLong, CULLong, CFloat, CDouble)
+ -- in the future, CHalf
+import Foreign.ForeignPtr (
+ ForeignPtr)
+
+
+-- |Scalar types
+-- -------------
+
+-- |Reified dictionaries
+-- -
+
+data IntegralDict a where
+ IntegralDict :: ( Bounded a, Enum a, Eq a, Ord a, Show a
+ , Bits a, Integral a, Num a, Real a)
+ => IntegralDict a
+
+data FloatingDict a where
+ FloatingDict :: ( Enum a, Eq a, Ord a, Show a
+ , Floating a, Fractional a, Num a, Real a, RealFrac a
+ , RealFloat a)
+ => FloatingDict a
+
+data NonNumDict a where
+ NonNumDict :: (Bounded a, Enum a, Eq a, Ord a, Show a) => NonNumDict a
+
+-- |Scalar type representation
+-- -
+
+-- |Integral types supported in APU computations.
+--
+data IntegralType a where
+ TypeInt :: IntegralDict Int -> IntegralType Int
+ TypeInt8 :: IntegralDict Int8 -> IntegralType Int8
+ TypeInt16 :: IntegralDict Int16 -> IntegralType Int16
+ TypeInt32 :: IntegralDict Int32 -> IntegralType Int32
+ TypeInt64 :: IntegralDict Int64 -> IntegralType Int64
+ TypeWord :: IntegralDict Word -> IntegralType Word
+ TypeWord8 :: IntegralDict Word8 -> IntegralType Word8
+ TypeWord16 :: IntegralDict Word16 -> IntegralType Word16
+ TypeWord32 :: IntegralDict Word32 -> IntegralType Word32
+ TypeWord64 :: IntegralDict Word64 -> IntegralType Word64
+ TypeCShort :: IntegralDict CShort -> IntegralType CShort
+ TypeCUShort :: IntegralDict CUShort -> IntegralType CUShort
+ TypeCInt :: IntegralDict CInt -> IntegralType CInt
+ TypeCUInt :: IntegralDict CUInt -> IntegralType CUInt
+ TypeCLong :: IntegralDict CLong -> IntegralType CLong
+ TypeCULong :: IntegralDict CULong -> IntegralType CULong
+ TypeCLLong :: IntegralDict CLLong -> IntegralType CLLong
+ TypeCULLong :: IntegralDict CULLong -> IntegralType CULLong
+
+-- |Floating-point types supported in APU computations.
+--
+data FloatingType a where
+ TypeFloat :: FloatingDict Float -> FloatingType Float
+ TypeDouble :: FloatingDict Double -> FloatingType Double
+ TypeCFloat :: FloatingDict CFloat -> FloatingType CFloat
+ TypeCDouble :: FloatingDict CDouble -> FloatingType CDouble
+
+-- |Non-numeric types supported in APU computations.
+--
+data NonNumType a where
+ TypeBool :: NonNumDict Bool -> NonNumType Bool -- ^marshaled to CInt
+ TypeChar :: NonNumDict Char -> NonNumType Char
+ TypeCChar :: NonNumDict CChar -> NonNumType CChar
+ TypeCSChar :: NonNumDict CSChar -> NonNumType CSChar
+ TypeCUChar :: NonNumDict CUChar -> NonNumType CUChar
+
+-- |Numeric APU types implement Num & Real
+--
+data NumType a where
+ IntegralNumType :: IntegralType a -> NumType a
+ FloatingNumType :: FloatingType a -> NumType a
+
+-- |Bounded APU types implement Bounded
+--
+data BoundedType a where
+ IntegralBoundedType :: IntegralType a -> BoundedType a
+ NonNumBoundedType :: NonNumType a -> BoundedType a
+
+-- |All scalar APU types implement Eq, Ord & Enum
+--
+data ScalarType a where
+ NumScalarType :: NumType a -> ScalarType a
+ NonNumScalarType :: NonNumType a -> ScalarType a
+
+-- |Showing type names
+-- -
+
+instance Show (IntegralType a) where
+ show (TypeInt _) = "Int"
+ show (TypeInt8 _) = "Int8"
+ show (TypeInt16 _) = "Int16"
+ show (TypeInt32 _) = "Int32"
+ show (TypeInt64 _) = "Int64"
+ show (TypeWord _) = "Word"
+ show (TypeWord8 _) = "Word8"
+ show (TypeWord16 _) = "Word16"
+ show (TypeWord32 _) = "Word32"
+ show (TypeWord64 _) = "Word64"
+ show (TypeCShort _) = "CShort"
+ show (TypeCUShort _) = "CUShort"
+ show (TypeCInt _) = "CInt"
+ show (TypeCUInt _) = "CUInt"
+ show (TypeCLong _) = "CLong"
+ show (TypeCULong _) = "CULong"
+ show (TypeCLLong _) = "CLLong"
+ show (TypeCULLong _) = "CULLong"
+
+instance Show (FloatingType a) where
+ show (TypeFloat _) = "Float"
+ show (TypeDouble _) = "Double"
+ show (TypeCFloat _) = "CFloat"
+ show (TypeCDouble _) = "CDouble"
+
+instance Show (NonNumType a) where
+ show (TypeBool _) = "Bool"
+ show (TypeChar _) = "Char"
+ show (TypeCChar _) = "CChar"
+ show (TypeCSChar _) = "CSChar"
+ show (TypeCUChar _) = "CUChar"
+
+instance Show (NumType a) where
+ show (IntegralNumType ty) = show ty
+ show (FloatingNumType ty) = show ty
+
+instance Show (BoundedType a) where
+ show (IntegralBoundedType ty) = show ty
+ show (NonNumBoundedType ty) = show ty
+
+instance Show (ScalarType a) where
+ show (NumScalarType ty) = show ty
+ show (NonNumScalarType ty) = show ty
+
+-- |Querying scalar type representations
+-- -
+
+-- Integral types
+--
+class (IsScalar a, IsNum a, IsBounded a) => IsIntegral a where
+ integralType :: IntegralType a
+
+instance IsIntegral Int where
+ integralType = TypeInt IntegralDict
+
+instance IsIntegral Int8 where
+ integralType = TypeInt8 IntegralDict
+
+instance IsIntegral Int16 where
+ integralType = TypeInt16 IntegralDict
+
+instance IsIntegral Int32 where
+ integralType = TypeInt32 IntegralDict
+
+instance IsIntegral Int64 where
+ integralType = TypeInt64 IntegralDict
+
+instance IsIntegral Word where
+ integralType = TypeWord IntegralDict
+
+instance IsIntegral Word8 where
+ integralType = TypeWord8 IntegralDict
+
+instance IsIntegral Word16 where
+ integralType = TypeWord16 IntegralDict
+
+instance IsIntegral Word32 where
+ integralType = TypeWord32 IntegralDict
+
+instance IsIntegral Word64 where
+ integralType = TypeWord64 IntegralDict
+
+instance IsIntegral CShort where
+ integralType = TypeCShort IntegralDict
+
+instance IsIntegral CUShort where
+ integralType = TypeCUShort IntegralDict
+
+instance IsIntegral CInt where
+ integralType = TypeCInt IntegralDict
+
+instance IsIntegral CUInt where
+ integralType = TypeCUInt IntegralDict
+
+instance IsIntegral CLong where
+ integralType = TypeCLong IntegralDict
+
+instance IsIntegral CULong where
+ integralType = TypeCULong IntegralDict
+
+instance IsIntegral CLLong where
+ integralType = TypeCLLong IntegralDict
+
+instance IsIntegral CULLong where
+ integralType = TypeCULLong IntegralDict
+
+-- Floating types
+--
+class (Floating a, IsScalar a, IsNum a) => IsFloating a where
+ floatingType :: FloatingType a
+
+instance IsFloating Float where
+ floatingType = TypeFloat FloatingDict
+
+instance IsFloating Double where
+ floatingType = TypeDouble FloatingDict
+
+instance IsFloating CFloat where
+ floatingType = TypeCFloat FloatingDict
+
+instance IsFloating CDouble where
+ floatingType = TypeCDouble FloatingDict
+
+-- Non-numeric types
+--
+class IsNonNum a where
+ nonNumType :: NonNumType a
+
+instance IsNonNum Bool where
+ nonNumType = TypeBool NonNumDict
+
+instance IsNonNum Char where
+ nonNumType = TypeChar NonNumDict
+
+instance IsNonNum CChar where
+ nonNumType = TypeCChar NonNumDict
+
+instance IsNonNum CSChar where
+ nonNumType = TypeCSChar NonNumDict
+
+instance IsNonNum CUChar where
+ nonNumType = TypeCUChar NonNumDict
+
+-- Numeric types
+--
+class (Num a, IsScalar a) => IsNum a where
+ numType :: NumType a
+
+instance IsNum Int where
+ numType = IntegralNumType integralType
+
+instance IsNum Int8 where
+ numType = IntegralNumType integralType
+
+instance IsNum Int16 where
+ numType = IntegralNumType integralType
+
+instance IsNum Int32 where
+ numType = IntegralNumType integralType
+
+instance IsNum Int64 where
+ numType = IntegralNumType integralType
+
+instance IsNum Word where
+ numType = IntegralNumType integralType
+
+instance IsNum Word8 where
+ numType = IntegralNumType integralType
+
+instance IsNum Word16 where
+ numType = IntegralNumType integralType
+
+instance IsNum Word32 where
+ numType = IntegralNumType integralType
+
+instance IsNum Word64 where
+ numType = IntegralNumType integralType
+
+instance IsNum CShort where
+ numType = IntegralNumType integralType
+
+instance IsNum CUShort where
+ numType = IntegralNumType integralType
+
+instance IsNum CInt where
+ numType = IntegralNumType integralType
+
+instance IsNum CUInt where
+ numType = IntegralNumType integralType
+
+instance IsNum CLong where
+ numType = IntegralNumType integralType
+
+instance IsNum CULong where
+ numType = IntegralNumType integralType
+
+instance IsNum CLLong where
+ numType = IntegralNumType integralType
+
+instance IsNum CULLong where
+ numType = IntegralNumType integralType
+
+instance IsNum Float where
+ numType = FloatingNumType floatingType
+
+instance IsNum Double where
+ numType = FloatingNumType floatingType
+
+instance IsNum CFloat where
+ numType = FloatingNumType floatingType
+
+instance IsNum CDouble where
+ numType = FloatingNumType floatingType
+
+-- Bounded types
+--
+class IsBounded a where
+ boundedType :: BoundedType a
+
+instance IsBounded Int where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded Int8 where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded Int16 where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded Int32 where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded Int64 where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded Word where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded Word8 where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded Word16 where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded Word32 where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded Word64 where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded CShort where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded CUShort where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded CInt where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded CUInt where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded CLong where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded CULong where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded CLLong where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded CULLong where
+ boundedType = IntegralBoundedType integralType
+
+instance IsBounded Bool where
+ boundedType = NonNumBoundedType nonNumType
+
+instance IsBounded Char where
+ boundedType = NonNumBoundedType nonNumType
+
+instance IsBounded CChar where
+ boundedType = NonNumBoundedType nonNumType
+
+instance IsBounded CSChar where
+ boundedType = NonNumBoundedType nonNumType
+
+instance IsBounded CUChar where
+ boundedType = NonNumBoundedType nonNumType
+
+-- All scalar type
+--
+class Typeable a => IsScalar a where
+ scalarType :: ScalarType a
+
+instance IsScalar Int where
+ scalarType = NumScalarType numType
+
+instance IsScalar Int8 where
+ scalarType = NumScalarType numType
+
+instance IsScalar Int16 where
+ scalarType = NumScalarType numType
+
+instance IsScalar Int32 where
+ scalarType = NumScalarType numType
+
+instance IsScalar Int64 where
+ scalarType = NumScalarType numType
+
+instance IsScalar Word where
+ scalarType = NumScalarType numType
+
+instance IsScalar Word8 where
+ scalarType = NumScalarType numType
+
+instance IsScalar Word16 where
+ scalarType = NumScalarType numType
+
+instance IsScalar Word32 where
+ scalarType = NumScalarType numType
+
+instance IsScalar Word64 where
+ scalarType = NumScalarType numType
+
+instance IsScalar CShort where
+ scalarType = NumScalarType numType
+
+instance IsScalar CUShort where
+ scalarType = NumScalarType numType
+
+instance IsScalar CInt where
+ scalarType = NumScalarType numType
+
+instance IsScalar CUInt where
+ scalarType = NumScalarType numType
+
+instance IsScalar CLong where
+ scalarType = NumScalarType numType
+
+instance IsScalar CULong where
+ scalarType = NumScalarType numType
+
+instance IsScalar CLLong where
+ scalarType = NumScalarType numType
+
+instance IsScalar CULLong where
+ scalarType = NumScalarType numType
+
+instance IsScalar Float where
+ scalarType = NumScalarType numType
+
+instance IsScalar Double where
+ scalarType = NumScalarType numType
+
+instance IsScalar CFloat where
+ scalarType = NumScalarType numType
+
+instance IsScalar CDouble where
+ scalarType = NumScalarType numType
+
+instance IsScalar Bool where
+ scalarType = NonNumScalarType nonNumType
+
+instance IsScalar Char where
+ scalarType = NonNumScalarType nonNumType
+
+instance IsScalar CChar where
+ scalarType = NonNumScalarType nonNumType
+
+instance IsScalar CSChar where
+ scalarType = NonNumScalarType nonNumType
+
+instance IsScalar CUChar where
+ scalarType = NonNumScalarType nonNumType
+
+-- |Extract reified dictionaries
+-- -
+
+integralDict :: IntegralType a -> IntegralDict a
+integralDict (TypeInt dict) = dict
+integralDict (TypeInt8 dict) = dict
+integralDict (TypeInt16 dict) = dict
+integralDict (TypeInt32 dict) = dict
+integralDict (TypeInt64 dict) = dict
+integralDict (TypeWord dict) = dict
+integralDict (TypeWord8 dict) = dict
+integralDict (TypeWord16 dict) = dict
+integralDict (TypeWord32 dict) = dict
+integralDict (TypeWord64 dict) = dict
+integralDict (TypeCShort dict) = dict
+integralDict (TypeCUShort dict) = dict
+integralDict (TypeCInt dict) = dict
+integralDict (TypeCUInt dict) = dict
+integralDict (TypeCLong dict) = dict
+integralDict (TypeCULong dict) = dict
+integralDict (TypeCLLong dict) = dict
+integralDict (TypeCULLong dict) = dict
+
+floatingDict :: FloatingType a -> FloatingDict a
+floatingDict (TypeFloat dict) = dict
+floatingDict (TypeDouble dict) = dict
+floatingDict (TypeCFloat dict) = dict
+floatingDict (TypeCDouble dict) = dict
+
+nonNumDict :: NonNumType a -> NonNumDict a
+nonNumDict (TypeBool dict) = dict
+nonNumDict (TypeChar dict) = dict
+nonNumDict (TypeCChar dict) = dict
+nonNumDict (TypeCSChar dict) = dict
+nonNumDict (TypeCUChar dict) = dict
+
+{-
+-- |Vector GPU data types
+-- ----------------------
+
+data CChar1 = CChar1 CChar
+data CChar2 = CChar2 CChar CChar
+data CChar3 = CChar3 CChar CChar CChar
+data CChar4 = CChar4 CChar CChar CChar CChar
+data CSChar1 = CSChar1 CSChar
+data CSChar2 = CSChar2 CSChar CSChar
+data CSChar3 = CSChar3 CSChar CSChar CSChar
+data CSChar4 = CSChar4 CSChar CSChar CSChar CSChar
+data CUChar1 = CUChar1 CUChar
+data CUChar2 = CUChar2 CUChar CUChar
+data CUChar3 = CUChar3 CUChar CUChar CUChar
+data CUChar4 = CUChar4 CUChar CUChar CUChar CUChar
+data CShort1 = CShort1 CShort
+data CShort2 = CShort2 CShort CShort
+data CShort3 = CShort3 CShort CShort CShort
+data CShort4 = CShort4 CShort CShort CShort CShort
+data CUShort1 = CUShort1 CUShort
+data CUShort2 = CUShort2 CUShort CUShort
+data CUShort3 = CUShort3 CUShort CUShort CUShort
+data CUShort4 = CUShort4 CUShort CUShort CUShort CUShort
+data CInt1 = CInt1 CInt
+data CInt2 = CInt2 CInt CInt
+data CInt3 = CInt3 CInt CInt CInt
+data CInt4 = CInt4 CInt CInt CInt CInt
+data CUInt1 = CUInt1 CUInt
+data CUInt2 = CUInt2 CUInt CUInt
+data CUInt3 = CUInt3 CUInt CUInt CUInt
+data CUInt4 = CUInt4 CUInt CUInt CUInt CUInt
+data CLong1 = CLong1 CLong
+data CLong2 = CLong2 CLong CLong
+data CLong3 = CLong3 CLong CLong CLong
+data CLong4 = CLong4 CLong CLong CLong CLong
+data CULong1 = CULong1 CULong
+data CULong2 = CULong2 CULong CULong
+data CULong3 = CULong3 CULong CULong CULong
+data CULong4 = CULong4 CULong CULong CULong CULong
+data CLLong1 = CLLong1 CLLong
+data CLLong2 = CLLong2 CLLong CLLong
+data CLLong3 = CLLong3 CLLong CLLong CLLong
+data CLLong4 = CLLong4 CLLong CLLong CLLong CLLong
+data CULLong1 = CULLong1 CULLong
+data CULLong2 = CULLong2 CULLong CULLong
+data CULLong3 = CULLong3 CULLong CULLong CULLong
+data CULLong4 = CULLong4 CULLong CULLong CULLong CULLong
+data CFloat1 = CFloat1 CFloat
+data CFloat2 = CFloat2 CFloat CFloat
+data CFloat3 = CFloat3 CFloat CFloat CFloat
+data CFloat4 = CFloat4 CFloat CFloat CFloat CFloat
+data CDouble1 = CDouble1 CDouble
+data CDouble2 = CDouble2 CDouble CDouble
+data CDouble3 = CDouble3 CDouble CDouble CDouble
+data CDouble4 = CDouble4 CDouble CDouble CDouble CDouble
+-- in the future, vector types for CHalf
+ -}
+
+-- |Arrays
+-- -------
+
+-- |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.
+--
+data Array dim e where
+ Array { arrayShape :: Shape dim -- ^extend of dimensions
+ , arrayElemType :: TupleType e -- ^constrains valid element types
+ , arrayId :: String -- ^for pretty printing
+ , arraySize :: Int -- ^data size in bytes
+ , arrayPtr :: ForeignPtr e -- ^data
+ } :: Array dim e
+
+-- |The shape of an array gives the number of elements in each dimensions
+-- (i.e., it is one more than the largest permitted index in that dimensions).
+-- This type family characterises permitted shape specifiers and maps
+-- specifier type to representation type of shapes and vanilla array indices.
+--
+type family Shape dim
+type instance Shape () = ()
+type instance Shape Int = ((), Int)
+type instance Shape (Int, Int) = (((), Int), Int)
+type instance Shape (Int, Int, Int) = ((((), Int), Int), Int)
+type instance Shape (Int, Int, Int, Int) = (((((), Int), Int), Int), Int)
+type instance Shape (Int, Int, Int, Int, Int)
+ = ((((((), Int), Int), Int), Int), Int)
+type instance Shape (Int, Int, Int, Int, Int, Int)
+ = (((((((), Int), Int), Int), Int), Int), Int)
+type instance Shape (Int, Int, Int, Int, Int, Int, Int)
+ = ((((((((), Int), Int), Int), Int), Int), Int), Int)
+type instance Shape (Int, Int, Int, Int, Int, Int, Int, Int)
+ = (((((((((), Int), Int), Int), Int), Int), Int), Int), Int)
+type instance Shape (Int, Int, Int, Int, Int, Int, Int, Int, Int)
+ = ((((((((((), Int), Int), Int), Int), Int), Int), Int), Int), Int)
+
+-- |Most common dimensionalities
+--
+type DIM0 = ()
+type DIM1 = ((), Int)
+type DIM2 = (((), Int), Int)
+type DIM3 = ((((), Int), Int), Int)
+
+-- |Our index class
+--
+class Ix ix where
+ dim :: ix -> Int -- ^number of dimensions (>= 0)
+ size :: ix -> Int -- ^for a *shape* yield the total number of
+ -- elements in that array
+ index :: ix -> ix -> Int -- ^corresponding index into a linear, row-major
+ -- representation of the array (first argument
+ -- is the shape)
+ -- FIXME: we might want an unsafeIndex, too
+
+instance Ix () where
+ dim _ = 0
+ size _ = 1
+ index _ _ = 0
+
+instance Ix Int where
+ dim _ = 1
+ size sh = sh
+ index sh ix
+ | ix >= 0 && ix <= sh = ix
+ | otherwise = error "Control.APU.Type: index out of bounds"
+
+instance (Ix ix1, Ix ix2) => Ix (ix1, ix2) where
+ dim (ix, _) = dim ix + 1
+ size (sh1, sh2) = size sh1 * size sh2
+ index (sh1, sh2) (ix1, ix2) = index sh1 ix1 * size sh2 + index sh2 ix2
+
+-- |Array representation inside collective computations; this is only to track
+-- the array, not to represent it
+--
+data Arr dim e where
+ Arr :: TupleType e -> String -> Arr dim e
+
+-- |Scalar results (both elementary scalars and tuples of scalars) are being
+-- represented as 0-dimensional singleton arrays
+--
+type Scalar a = Arr DIM0 a
+
+
+-- |Compound types
+-- ---------------
+
+-- |Tuples of scalar types as nested pairs (we interpret them as unlifted pairs)
+--
+data TupleType t where
+ UnitTuple :: TupleType ()
+ SingleTuple :: ScalarType a -> TupleType a
+ PairTuple :: TupleType a -> TupleType b -> TupleType (a, b)
+
+-- |Tuples of scalar and array types - all types manipulated in GPU code
+--
+data AnyType t where
+ UnitType :: AnyType a
+ ScalarType :: ScalarType a -> AnyType a
+ ArrayType :: TupleType a -> AnyType (Array dim a)
+ PairType :: AnyType a -> AnyType b -> AnyType (a, b)
+
+-- |Querying tuple type representations
+-- -
+
+class Typeable a => IsTuple a where
+ tupleType :: TupleType a
+
+instance IsTuple () where
+ tupleType = UnitTuple
+
+instance IsScalar a => IsTuple a where
+ tupleType = SingleTuple scalarType
+
+instance (IsTuple a, IsTuple b) => IsTuple (a, b) where
+ tupleType = PairTuple tupleType tupleType
+
+-- |Possible results of collective array computations are tuples of
+-- multi-dimensional arrays
+--
+class CompResult r where
+ strings :: r -> [String]
+
+instance CompResult () where
+ strings _ = []
+
+instance CompResult (Arr dim e) where
+ strings (Arr _ str) = [str]
+
+instance (CompResult r1, CompResult r2) => CompResult (r1, r2) where
+ strings (r1, r2) = strings r1 ++ strings r2
27 Data/Array/Accelerate/Typeable.hs
@@ -0,0 +1,27 @@
+-- |Embedded array processing language: Typeable utilities
+--
+-- Copyright (c) [2008..2009] Manuel M T Chakravarty, Gabriele Keller, Sean Lee
+--
+-- License: BSD3
+--
+--- Description ---------------------------------------------------------------
+--
+
+module Data.Array.Accelerate.Typeable (
+ cast1
+) where
+
+-- standard libraries
+import Data.Maybe
+import Data.Typeable
+
+-- friends
+import Data.Array.Accelerate.AST (Idx)
+
+
+instance Typeable2 Idx where
+ typeOf2 _ = mkTyCon "Data.Array.Accelerate.AST.Idx" `mkTyConApp` []
+
+cast1 :: (Typeable1 t, Typeable1 t') => t a -> Maybe (t' a)
+cast1 = fromJust . gcast1 . Just
+
12 INSTALL
@@ -0,0 +1,12 @@
+Requirements: Glasgow Haskell Compiler (GHC), 6.10.1 or later
+
+Standard Cabal installation:
+
+ % runhaskell Setup.hs configure --prefix=INSTALLPATH
+ % runhaskell Setup.hs build
+ % runhaskell Setup.hs install
+ OR
+ runhaskell Setup.hs install -- user
+
+Then, to use the library, pass the flag "-package accelerate" to GHC.
+
24 LICENSE
@@ -0,0 +1,24 @@
+Copyright (c) [2007..2009] Manuel M T Chakravarty, Gabriele Keller & Sean Lee
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of the University of New South Wales nor the
+ names of its contributors may be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ''AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL COPYRIGHT HOLDERS BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
4 Setup.hs
@@ -0,0 +1,4 @@
+#! /usr/bin/env runhaskell
+
+import Distribution.Simple
+main = defaultMain
28 accelerate.cabal
@@ -0,0 +1,28 @@
+Name: accelerate
+Version: 0.3.0
+Synopsis: An embedded language for accelerated array processing
+Description: This libraries defines an embedded language for array
+ computations that are suitable for offloading to compute
+ accelerators, such as CUDA-capable GPUs.
+License: BSD3
+License-file: LICENSE
+Author: Manuel M T Chakravarty, Gabriele Keller & Sean Lee
+Maintainer: Manuel M T Chakravarty <chak@cse.unsw.edu.au>
+Category: Concurrency, Data
+Build-type: Simple
+extra-source-files: INSTALL
+
+Build-Depends: array, base, haskell98, mtl
+Exposed-modules: Data.Array.Accelerate
+Other-modules: Data.Array.Accelerate.AST
+ Data.Array.Accelerate.Language
+ Data.Array.Accelerate.Pretty
+ Data.Array.Accelerate.Run
+ Data.Array.Accelerate.Smart
+ Data.Array.Accelerate.Type
+ Data.Array.Accelerate.Typeable
+ghc-options: -Wall -fno-warn-orphans
+Extensions: FlexibleContexts, FlexibleInstances,
+ ExistentialQuantification, GADTs, TypeFamilies,
+ ScopedTypeVariables,
+ BangPatterns, PatternGuards, TypeOperators
13 examples/simple/DotP.hs
@@ -0,0 +1,13 @@
+module DotP where
+
+import Prelude hiding (replicate, zip, map, filter, max, min, not, zipWith)
+import qualified Prelude
+
+import Data.Array.Accelerate
+
+dotp :: Array DIM1 Float -> Array DIM1 Float -> AP (Scalar Float)
+dotp xs ys
+ = do
+ xs' <- use xs
+ ys' <- use ys
+ zipWith (*) xs' ys' >>= fold (+) 0
13 examples/simple/SAXPY.hs
@@ -0,0 +1,13 @@
+module SAXPY where
+
+import Prelude hiding (replicate, zip, map, filter, max, min, not, zipWith)
+import qualified Prelude
+
+import Data.Array.Accelerate
+
+saxpy :: Float -> Array DIM1 Float -> Array DIM1 Float -> AP (Arr DIM1 Float)
+saxpy alpha xs ys
+ = do
+ xs' <- use xs
+ ys' <- use ys
+ zipWith (\x y -> mkVal alpha * x * y) xs' ys'

0 comments on commit 835e4ff

Please sign in to comment.
Something went wrong with that request. Please try again.