diff --git a/Data/Array/Parallel.hs b/Data/Array/Parallel.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel.hs @@ -0,0 +1,227 @@ +{-# LANGUAGE ParallelArrays #-} +{-# OPTIONS_GHC -fvectorise #-} + +-- | User level interface to vectorised parallel arrays. +-- +-- /WARNING:/ In the current implementation, the functionality provided in +-- this module is tied to the vectoriser pass of GHC, invoked by `-fvectorise`. +-- These functions will not work at all in unvectorised code. To operate on +-- parallel arrays in unvectorised code, use the functions in +-- "Data.Array.Parallel.PArray" and convert between array representations by +-- using `fromPArrayP` and `toPArrayP` from /vectorised/ code. +--- +-- The semantic difference between standard Haskell arrays (aka "lazy +-- arrays") and parallel arrays (aka "strict arrays") is that the evaluation +-- of two different elements of a lazy array is independent, whereas in a +-- strict array either non or all elements are evaluated. +-- In other words, when a parallel array is evaluated to WHNF, all its elements +-- will be evaluated to WHNF. The name parallel array indicates that all array +-- elements may, in general, be evaluated to WHNF in parallel without any +-- need to resort to speculative evaluation. This parallel evaluation +-- semantics is also beneficial in the sequential case, as it facilitates +-- loop-based array processing as known from classic array-based languages, +-- such as Fortran. +-- +-- The interface of this module is essentially a variant of the list +-- component of the Prelude, but also includes some functions (such as +-- permutations) that are not provided for lists. The following list of +-- operations are not supported on parallel arrays, as they would require the +-- infinite parallel arrays: `iterate', `repeat', and `cycle'. +-- +-- UGLY HACK ALERT: +-- Same ugly hack as in 'base:GHC.PArr'! We could do without in this module by +-- using the type synonym 'PArr' instead of '[::]', but that would lead to +-- significantly worse error message for end users. +-- +module Data.Array.Parallel + ( module Data.Array.Parallel.Prelude + + -- * Conversions + , PArray + , fromPArrayP + , toPArrayP + , fromNestedPArrayP + + -- * Constructors + , emptyP + , singletonP + , replicateP + , appendP, (+:+) + , concatP + + -- * Projections + , lengthP + , indexP, (!:) + , sliceP + + -- * Traversals + , mapP + , zipWithP + , crossMapP + + -- * Filtering + , filterP + + -- * Ziping and Unzipping + , zipP + , unzipP) +where +-- Primitives needed by the vectoriser. +import Data.Array.Parallel.Prim () + +import Data.Array.Parallel.PArr +import Data.Array.Parallel.Prelude +import Data.Array.Parallel.Lifted +import Data.Array.Parallel.PArray.PData.Base (PArray(..)) + + +------------------------------------------------------------------------------- +-- IMPORTANT: +-- We only define the signatures of operations on parallel arrays, and give +-- and bodies that convince GHC that these functions don't just diverge. +-- The vectoriser rewrites them to entirely the code given in the VECTORISE +-- pragmas. +-- +-- The functions must be eta-expanded, so the right of the binding is +-- something of the final return type. The vectoriser takes the type of the +-- body to determine what PA dictionary to pass. +-- +-- We also put bangs (!) on the arguments to indicate to the GHC strictness +-- analyser that these paramters will really be used in the vectorised code. +-- +-- This won't work: mapP = undefined +-- You need this: mapP !_ !_ = [::] +-- +-- The bindings have NOINLINE pragmas because we never want to use the +-- actual body code (because it's fake anyway). +-- + +-- Conversions ---------------------------------------------------------------- +-- | O(1). Convert between `PArray` and [::] array representations. +fromPArrayP :: PArray a -> [:a:] +fromPArrayP !_ = emptyP +{-# NOINLINE fromPArrayP #-} +{-# VECTORISE fromPArrayP = fromPArrayPP #-} + + +-- | O(1). Convert between `PArray` and [::] array representations. +toPArrayP :: [:a:] -> PArray a +toPArrayP !_ = PArray 0# (error "toPArrayP: unvectorised") +{-# NOINLINE toPArrayP #-} +{-# VECTORISE toPArrayP = toPArrayPP #-} + + +-- | O(1). Convert between `PArray` and [::] array representations. +fromNestedPArrayP :: PArray (PArray a) -> [:[:a:]:] +fromNestedPArrayP !_ = emptyP +{-# NOINLINE fromNestedPArrayP #-} +{-# VECTORISE fromNestedPArrayP = fromNestedPArrayPP #-} + + +-- Constructors --------------------------------------------------------------- +-- | Construct an empty array, with no elements. +emptyP :: [:a:] +emptyP = emptyPArr +{-# NOINLINE emptyP #-} +{-# VECTORISE emptyP = emptyPP #-} + + +-- | Construct an array with a single element. +singletonP :: a -> [:a:] +singletonP = singletonPArr +{-# NOINLINE singletonP #-} +{-# VECTORISE singletonP = singletonPP #-} + + +-- | Construct an array by replicating the given element some number of times. +replicateP :: Int -> a -> [:a:] +replicateP = replicatePArr +{-# NOINLINE replicateP #-} +{-# VECTORISE replicateP = replicatePP #-} + + +-- | Append two arrays. +appendP, (+:+) :: [:a:] -> [:a:] -> [:a:] +(+:+) !_ !_ = emptyP +{-# NOINLINE (+:+) #-} +{-# VECTORISE (+:+) = appendPP #-} + +appendP !_ !_ = emptyP +{-# NOINLINE appendP #-} +{-# VECTORISE appendP = appendPP #-} + + +-- | Concatenate an array of arrays. +concatP :: [:[:a:]:] -> [:a:] +concatP !_ = emptyP +{-# NOINLINE concatP #-} +{-# VECTORISE concatP = concatPP #-} + + +-- Projections ---------------------------------------------------------------- +-- | Take the length of an array. +lengthP :: [:a:] -> Int +lengthP = lengthPArr +{-# NOINLINE lengthP #-} +{-# VECTORISE lengthP = lengthPP #-} + +-- | Lookup a single element from the source array. +indexP, (!:) :: [:a:] -> Int -> a +(!:) = indexPArr +{-# NOINLINE (!:) #-} +{-# VECTORISE (!:) = indexPP #-} + +indexP = indexPArr +{-# NOINLINE indexP #-} +{-# VECTORISE indexP = indexPP #-} + + +-- | Extract a slice from an array. +sliceP :: Int -> Int -> [:a:] -> [:a:] +sliceP !_ !_ !_ = emptyP +{-# NOINLINE sliceP #-} +{-# VECTORISE sliceP = slicePP #-} + + +-- Traversals ----------------------------------------------------------------- +-- | Apply a worker function to every element of an array. +mapP :: (a -> b) -> [:a:] -> [:b:] +mapP !_ !_ = emptyP +{-# NOINLINE mapP #-} +{-# VECTORISE mapP = mapPP #-} + +-- | Apply a worker function to every pair of two arrays. +zipWithP :: (a -> b -> c) -> [:a:] -> [:b:] -> [:c:] +zipWithP !_ !_ !_ = emptyP +{-# NOINLINE zipWithP #-} +{-# VECTORISE zipWithP = zipWithPP #-} + +-- | For every element 'a' apply the function to get an array of 'b' then, +-- and return an array of all the 'a's and 'b's. +crossMapP :: [:a:] -> (a -> [:b:]) -> [:(a, b):] +{-# NOINLINE crossMapP #-} +crossMapP !_ !_ = emptyP +{-# VECTORISE crossMapP = crossMapPP #-} + + +-- Filtering ----------------------------------------------------------------- +-- | Filter an array, keeping only those elements that match the given predicate. +filterP :: (a -> Bool) -> [:a:] -> [:a:] +filterP !_ !_ = emptyP +{-# NOINLINE filterP #-} +{-# VECTORISE filterP = filterPP #-} + + +-- Zipping and Unzipping ------------------------------------------------------ +-- | Zip a pair of arrays into an array of pairs. +zipP :: [:a:] -> [:b:] -> [:(a, b):] +zipP !_ !_ = emptyP +{-# NOINLINE zipP #-} +{-# VECTORISE zipP = zipPP #-} + + +-- | Unzip an array of pairs into a pair of arrays. +unzipP :: [:(a, b):] -> ([:a:], [:b:]) +unzipP !_ = (emptyP, emptyP) +{-# NOINLINE unzipP #-} +{-# VECTORISE unzipP = unzipPP #-} diff --git a/Data/Array/Parallel/Lifted.hs b/Data/Array/Parallel/Lifted.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/Lifted.hs @@ -0,0 +1,15 @@ + +-- | Closures and closure converted lifted array combinators. +module Data.Array.Parallel.Lifted + ( module Data.Array.Parallel.Lifted.Closure + , module Data.Array.Parallel.Lifted.Combinators) +where +import Data.Array.Parallel.Lifted.Closure +import Data.Array.Parallel.Lifted.Combinators + + + + + + + diff --git a/Data/Array/Parallel/Lifted/Closure.hs b/Data/Array/Parallel/Lifted/Closure.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/Lifted/Closure.hs @@ -0,0 +1,460 @@ +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | Closures. +-- Used when closure converting the source program during vectorisation. +module Data.Array.Parallel.Lifted.Closure + ( -- * Closures. + (:->)(..) + , ($:) + + -- * Array Closures. + , PData(..) + , ($:^), liftedApply + + -- * Closure Construction. + , closure1, closure2, closure3, closure4, closure5 + , closure1', closure2', closure3', closure4', closure5') +where +import Data.Array.Parallel.Pretty +import Data.Array.Parallel.PArray.PData.Base +import Data.Array.Parallel.PArray.PData.Unit +import Data.Array.Parallel.PArray.PData.Tuple2 +import Data.Array.Parallel.PArray.PData.Tuple3 +import Data.Array.Parallel.PArray.PData.Tuple4 +import Data.Array.Parallel.PArray.PRepr +import qualified Data.Vector as V +import GHC.Exts + + +-- Closures ------------------------------------------------------------------- +-- | Define the fixity of the closure type constructor. +infixr 0 :-> +infixl 1 $:, $:^ + +-- | The type of closures. +-- This bundles up: +--- 1) the 'vectorised' version of the function that takes an explicit environment +-- 2) the 'lifted' version, that works on arrays. +-- The first parameter of the lifted version is the 'lifting context' +-- that gives the length of the arrays being operated on. +-- 3) the environment of the closure. +-- +-- The vectoriser closure-converts the source program so that all functions +-- are expressed in this form. +data (a :-> b) + = forall env. PA env + => Clo (env -> a -> b) + (Int -> PData env -> PData a -> PData b) + env + +-- | Closure application. +($:) :: (a :-> b) -> a -> b +($:) (Clo fv _fl env) x = fv env x +{-# INLINE_CLOSURE ($:) #-} + + +-- Array Closures ------------------------------------------------------------- +-- | Arrays of closures (aka array closures) +-- We need to represent arrays of closures when vectorising partial applications. +-- +-- For example, consider: +-- @mapP (+) xs :: [: Int -> Int :]@ +-- +-- Representing this an array of thunks doesn't work because we can't evaluate +-- it in a data parallel manner. Instead, we want *one* function applied to many +-- array elements. +-- +-- Instead, such an array of closures is represented as the vectorised and +-- lifted versions of (+), along with an environment array xs that contains the +-- partially applied arguments. +-- +-- @mapP (+) xs ==> AClo plus_v plus_l xs@ +-- +data instance PData (a :-> b) + = forall env. PA env + => AClo (env -> a -> b) + (Int -> PData env -> PData a -> PData b) + (PData env) + +data instance PDatas (a :-> b) + = forall env. PA env + => AClos (env -> a -> b) + (Int -> PData env -> PData a -> PData b) + (PDatas env) + + +-- | Lifted closure application. +($:^) :: PArray (a :-> b) -> PArray a -> PArray b +PArray n# (AClo _ f es) $:^ PArray _ as + = PArray n# (f (I# n#) es as) +{-# INLINE ($:^) #-} + + +-- | Lifted closure application, taking an explicit lifting context. +liftedApply :: Int -> PData (a :-> b) -> PData a -> PData b +liftedApply n (AClo _ fl envs) as + = fl n envs as +{-# INLINE_CLOSURE liftedApply #-} + + +-- Closure Construction ------------------------------------------------------- +-- These functions are used for building closure representations of primitive +-- functions. They're used in D.A.P.Lifted.Combinators where we define the +-- closure converted lifted array combinators that vectorised code uses. + +-- | Construct an arity-1 closure, +-- from unlifted and lifted versions of a primitive function. +closure1 + :: (a -> b) + -> (Int -> PData a -> PData b) + -> (a :-> b) + +closure1 fv fl + = Clo (\_env -> fv) + (\n _env -> fl n) + () +{-# INLINE_CLOSURE closure1 #-} + + +-- | Construct an arity-2 closure, +-- from lifted and unlifted versions of a primitive function. +closure2 + :: forall a b c. PA a + => (a -> b -> c) + -> (Int -> PData a -> PData b -> PData c) + -> (a :-> b :-> c) + +closure2 fv fl + = let fv_1 _ xa = Clo fv fl xa + fl_1 _ _ xs = AClo fv fl xs + + in Clo fv_1 fl_1 () +{-# INLINE_CLOSURE closure2 #-} + + +-- | Construct an arity-3 closure +-- from lifted and unlifted versions of a primitive function. +closure3 + :: forall a b c d. (PA a, PA b) + => (a -> b -> c -> d) + -> (Int -> PData a -> PData b -> PData c -> PData d) + -> (a :-> b :-> c :-> d) + +closure3 fv fl + = let fv_1 _ xa = Clo fv_2 fl_2 xa + fl_1 _ _ xs = AClo fv_2 fl_2 xs + + ----- + fv_2 xa yb = Clo fv_3 fl_3 (xa, yb) + fl_2 _ xs ys = AClo fv_3 fl_3 (PTuple2 xs ys) + + ----- + fv_3 (xa, yb) zc = fv xa yb zc + fl_3 n (PTuple2 xs ys) zs = fl n xs ys zs + + in Clo fv_1 fl_1 () +{-# INLINE_CLOSURE closure3 #-} + + +-- | Construct an arity-4 closure +-- from lifted and unlifted versions of a primitive function. +closure4 + :: forall a b c d e. (PA a, PA b, PA c) + => (a -> b -> c -> d -> e) + -> (Int -> PData a -> PData b -> PData c -> PData d -> PData e) + -> (a :-> b :-> c :-> d :-> e) + +closure4 fv fl + = let fv_1 _ xa = Clo fv_2 fl_2 xa + fl_1 _ _ xs = AClo fv_2 fl_2 xs + + fv_2 xa yb = Clo fv_3 fl_3 (xa, yb) + fl_2 _ xs ys = AClo fv_3 fl_3 (PTuple2 xs ys) + + fv_3 (xa, yb) zc = Clo fv_4 fl_4 (xa, yb, zc) + fl_3 _ (PTuple2 xs ys) zs = AClo fv_4 fl_4 (PTuple3 xs ys zs) + + fv_4 (xa, yb, zc) ad = fv xa yb zc ad + fl_4 n (PTuple3 xs ys zs) as = fl n xs ys zs as + + in Clo fv_1 fl_1 () +{-# INLINE_CLOSURE closure4 #-} + + +-- | Construct an arity-5 closure +-- from lifted and unlifted versions of a primitive function. +closure5 + :: forall a b c d e f. (PA a, PA b, PA c, PA d) + => (a -> b -> c -> d -> e -> f) + -> (Int -> PData a -> PData b -> PData c -> PData d -> PData e -> PData f) + -> (a :-> b :-> c :-> d :-> e :-> f) + +closure5 fv fl + = let fv_1 _ xa = Clo fv_2 fl_2 xa + fl_1 _ _ xs = AClo fv_2 fl_2 xs + + fv_2 xa yb = Clo fv_3 fl_3 (xa, yb) + fl_2 _ xs ys = AClo fv_3 fl_3 (PTuple2 xs ys) + + fv_3 (xa, yb) zc = Clo fv_4 fl_4 (xa, yb, zc) + fl_3 _ (PTuple2 xs ys) zs = AClo fv_4 fl_4 (PTuple3 xs ys zs) + + fv_4 (xa, yb, zc) ad = Clo fv_5 fl_5 (xa, yb, zc, ad) + fl_4 _ (PTuple3 xs ys zs) as = AClo fv_5 fl_5 (PTuple4 xs ys zs as) + + fv_5 (xa, yb, zc, ad) be = fv xa yb zc ad be + fl_5 n (PTuple4 xs ys zs as) bs = fl n xs ys zs as bs + + in Clo fv_1 fl_1 () +{-# INLINE_CLOSURE closure5 #-} + + +-- Closure constructors that take PArrays ------------------------------------- +-- These versions are useful when defining prelude functions such as in +-- D.A.P.Prelude.Int. They let us promote functions that work on PArrays +-- to closures, while inferring the lifting context from the first argument. + +-- | Construct an arity-1 closure. +closure1' + :: forall a b + . (a -> b) + -> (PArray a -> PArray b) + -> (a :-> b) + +closure1' fv fl + = let {-# INLINE fl' #-} + fl' (I# n#) pdata + = case fl (PArray n# pdata) of + PArray _ pdata' -> pdata' + in closure1 fv fl' +{-# INLINE_CLOSURE closure1' #-} + + +-- | Construct an arity-2 closure. +closure2' + :: forall a b c. PA a + => (a -> b -> c) + -> (PArray a -> PArray b -> PArray c) + -> (a :-> b :-> c) + +closure2' fv fl + = let {-# INLINE fl' #-} + fl' (I# n#) !pdata1 !pdata2 + = case fl (PArray n# pdata1) (PArray n# pdata2) of + PArray _ pdata' -> pdata' + in closure2 fv fl' +{-# INLINE_CLOSURE closure2' #-} + + +-- | Construct an arity-3 closure. +closure3' + :: forall a b c d. (PA a, PA b) + => (a -> b -> c -> d) + -> (PArray a -> PArray b -> PArray c -> PArray d) + -> (a :-> b :-> c :-> d) + +closure3' fv fl + = let {-# INLINE fl' #-} + fl' (I# n#) !pdata1 !pdata2 !pdata3 + = case fl (PArray n# pdata1) (PArray n# pdata2) (PArray n# pdata3) of + PArray _ pdata' -> pdata' + in closure3 fv fl' +{-# INLINE_CLOSURE closure3' #-} + + +-- | Construct an arity-4 closure. +closure4' + :: forall a b c d e. (PA a, PA b, PA c) + => (a -> b -> c -> d -> e) + -> (PArray a -> PArray b -> PArray c -> PArray d -> PArray e) + -> (a :-> b :-> c :-> d :-> e) + +closure4' fv fl + = let {-# INLINE fl' #-} + fl' (I# n#) !pdata1 !pdata2 !pdata3 !pdata4 + = case fl (PArray n# pdata1) (PArray n# pdata2) + (PArray n# pdata3) (PArray n# pdata4) of + PArray _ pdata' -> pdata' + in closure4 fv fl' +{-# INLINE_CLOSURE closure4' #-} + + +-- | Construct an arity-5 closure. +closure5' + :: forall a b c d e f. (PA a, PA b, PA c, PA d) + => (a -> b -> c -> d -> e -> f) + -> (PArray a -> PArray b -> PArray c -> PArray d -> PArray e -> PArray f) + -> (a :-> b :-> c :-> d :-> e :-> f) + +closure5' fv fl + = let {-# INLINE fl' #-} + fl' (I# n#) !pdata1 !pdata2 !pdata3 !pdata4 !pdata5 + = case fl (PArray n# pdata1) (PArray n# pdata2) + (PArray n# pdata3) (PArray n# pdata4) + (PArray n# pdata5) of + PArray _ pdata' -> pdata' + in closure5 fv fl' +{-# INLINE_CLOSURE closure5' #-} + + +-- PData instance for closures ------------------------------------------------ +-- This needs to be here instead of in a module D.A.P.PArray.PData.Closure +-- to break an import loop. +-- We use INLINE_CLOSURE for these bindings instead of INLINE_PDATA because +-- most of the functions return closure constructors, and we want to eliminate +-- these early in the compilation. +-- +instance PR (a :-> b) where + + {-# NOINLINE validPR #-} + validPR (AClo _ _ env) + = validPA env + + {-# NOINLINE nfPR #-} + nfPR (AClo fv fl envs) + = fv `seq` fl `seq` nfPA envs `seq` () + + -- We can't test functions for equality. + -- We can't test the environments either, because they're existentially quantified. + -- Provided the closures have the same type, we just call them similar. + {-# NOINLINE similarPR #-} + similarPR _ _ + = True + + {-# NOINLINE coversPR #-} + coversPR weak (AClo _ _ envs) ix + = coversPA weak envs ix + + {-# NOINLINE pprpPR #-} + pprpPR (Clo _ _ env) + = vcat + [ text "Clo" + , pprpPA env ] + + {-# NOINLINE pprpDataPR #-} + pprpDataPR (AClo _ _ envs) + = vcat + [ text "AClo" + , pprpDataPA envs ] + + + -- Constructors ------------------------------- + {-# INLINE_CLOSURE emptyPR #-} + emptyPR + = let die = error "emptydPR[:->]: no function in empty closure array" + in AClo die die (emptyPA :: PData ()) + + {-# INLINE_CLOSURE replicatePR #-} + replicatePR n (Clo fv fl envs) + = AClo fv fl (replicatePA n envs) + + {-# INLINE_CLOSURE replicatesPR #-} + replicatesPR lens (AClo fv fl envs) + = AClo fv fl (replicatesPA lens envs) + + + -- Projections -------------------------------- + {-# INLINE_CLOSURE lengthPR #-} + lengthPR (AClo _ _ envs) + = lengthPA envs + + {-# INLINE_CLOSURE indexPR #-} + indexPR (AClo fv fl envs) ix + = Clo fv fl $ indexPA envs ix + + {-# INLINE_CLOSURE indexsPR #-} + indexsPR (AClos fv fl envs) srcixs + = AClo fv fl $ indexsPA envs srcixs + + {-# INLINE_CLOSURE extractPR #-} + extractPR (AClo fv fl envs) start len + = AClo fv fl $ extractPA envs start len + + {-# INLINE_CLOSURE extractssPR #-} + extractssPR (AClos fv fl envs) ssegd + = AClo fv fl $ extractssPA envs ssegd + + {-# INLINE_CLOSURE extractvsPR #-} + extractvsPR (AClos fv fl envs) vsegd + = AClo fv fl $ extractvsPA envs vsegd + + + -- Pack and Combine --------------------------- + {-# INLINE_CLOSURE packByTagPR #-} + packByTagPR (AClo fv fl envs) tags tag + = AClo fv fl $ packByTagPA envs tags tag + + + -- Conversions -------------------------------- + {-# NOINLINE toVectorPR #-} + toVectorPR (AClo fv fl envs) + = V.map (Clo fv fl) $ toVectorPA envs + + + -- PDatas ------------------------------------- + -- When constructing an empty array of closures, we don't know what + {-# INLINE_CLOSURE emptydPR #-} + emptydPR + = let die = error "emptydPR[:->]: no function in empty closure array" + in AClos die die (emptydPA :: PDatas ()) + + {-# INLINE_CLOSURE singletondPR #-} + singletondPR (AClo fv fl env) + = AClos fv fl $ singletondPA env + + {-# INLINE_CLOSURE lengthdPR #-} + lengthdPR (AClos _ _ env) + = lengthdPA env + + {-# INLINE_CLOSURE indexdPR #-} + indexdPR (AClos fv fl envs) ix + = AClo fv fl $ indexdPA envs ix + + {-# NOINLINE toVectordPR #-} + toVectordPR (AClos fv fl envs) + = V.map (AClo fv fl) $ toVectordPA envs + + + -- Unsupported -------------------------------- + -- To support these operators we'd need to manage closure arrays containing + -- multiple hetrogenous functions. But this is more work than we care for + -- right now. Note that the problematic functions are all constructors, and + -- we can't know that all the parameters contain the same function. + appendPR = dieHetroFunctions "appendPR" + appendsPR = dieHetroFunctions "appendsPR" + combine2PR = dieHetroFunctions "combine2PR" + fromVectorPR = dieHetroFunctions "fromVectorPR" + appenddPR = dieHetroFunctions "appenddPR" + fromVectordPR = dieHetroFunctions "fromVectordPR" + + +dieHetroFunctions :: String -> a +dieHetroFunctions name + = error $ unlines + [ "Data.Array.Parallel.Lifted.Closure." ++ name + , " Unsupported Array Operation" + , " It looks like you're trying to define an array containing multiple" + , " hetrogenous functions, or trying to select between multiple arrays" + , " of functions in vectorised code. Although we could support this by" + , " constructing a new function that selects between them depending on" + , " what the array index is, to make that anywhere near efficient is" + , " more work than we care to do right now, and we expect this use case" + , " to be uncommon. If you want this to work then contact the DPH team" + , " and ask what you can do to help." ] + + +-- PRepr Instance ------------------------------------------------------------- +-- This needs to be here instead of in D.A.P.PRepr.Instances +-- to break an import loop. +-- +type instance PRepr (a :-> b) + = a :-> b + +instance (PA a, PA b) => PA (a :-> b) where + toPRepr = id + fromPRepr = id + toArrPRepr = id + fromArrPRepr = id + toArrPReprs = id + fromArrPReprs = id diff --git a/Data/Array/Parallel/Lifted/Combinators.hs b/Data/Array/Parallel/Lifted/Combinators.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/Lifted/Combinators.hs @@ -0,0 +1,232 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS -fno-spec-constr #-} +#include "fusion-phases.h" + +-- NOTE NOTE NOTE +-- This file is IDENTICAL to the one in dph-lifted-boxed. +-- If you update one then update the other as well. + +-- | Closure converted lifted array combinators. +-- The vectoriser produces code that uses these combinators directly. +-- +-- All of the combinators in this module are polymorphic, work on `PArray`, and +-- take `PA` dictionaries. Combinators that are specific to a certain element type, +-- like `Int`, are defined in the corresponding prelude module, +-- eg "Data.Array.Parallel.Prelude.Int". +-- +module Data.Array.Parallel.Lifted.Combinators + ( -- * Conversions + fromPArrayPP + , toPArrayPP + , fromNestedPArrayPP + + -- * Constructors + , emptyPP + , singletonPP + , replicatePP + , appendPP + + -- * Projections + , lengthPP + , indexPP + , slicePP + + -- * Traversals + , mapPP + , zipWithPP + , crossMapPP + + -- * Filtering + , filterPP + + -- * Concatenation + , concatPP + + -- * Tuple functions + , zipPP + , unzipPP) +where +import Data.Array.Parallel.Lifted.Closure +import Data.Array.Parallel.PArray.PData as PA +import Data.Array.Parallel.PArray.PRepr as PA +import Data.Array.Parallel.PArray as PA + + +-- Conversions ================================================================ +-- The following identity functions are used as the vectorised versions of the +-- functions that convert between the source level array type [:a:] and the +-- PArray type which is used in the library. + +-- | Identity function, used as the vectorised version of fromPArrayP. +fromPArrayPP :: PA a => PArray a :-> PArray a +fromPArrayPP = closure1 (\x -> x) (\_ xs -> xs) +{-# INLINE fromPArrayPP #-} + + +-- | Identity function, used as the vectorised version of toPArrayP. +toPArrayPP :: PA a => PArray a :-> PArray a +toPArrayPP = closure1 (\x -> x) (\_ xs -> xs) +{-# INLINE toPArrayPP #-} + + +-- | Identity function, used as the vectorised version of fromNestedPArrayP +fromNestedPArrayPP :: PA a => (PArray (PArray a) :-> PArray (PArray a)) +fromNestedPArrayPP = closure1 (\xs -> xs) (\_ xss -> xss) +{-# INLINE fromNestedPArrayPP #-} + + +-- Combinators ================================================================ +-- For each combinator: +-- The *PP_v version is the "vectorised" version that has had its parameters +-- closure converted. For first-order functions, the *PP_v version is +-- identical to the standard *PA version from D.A.P.PArray, so we can +-- just use that directly. +-- +-- The *PP_l version is the "lifted" version that works on arrays of arrays. +-- Each of these functions also takes an integer as its first argument. +-- This is the "lifting context" that says now many element to expect in +-- each of the argument arrays. +-- +-- The *PP version contains both the vectorised and lifted versions wrapped +-- up in a closure. The code produced by the vectoriser uses the *PP +-- versions directly. + + +-- Constructors --------------------------------------------------------------- +-- | O(1). Construct an empty array. +emptyPP :: PA a => PArray a +emptyPP = PA.empty +{-# INLINE_PA emptyPP #-} + + +-- | O(1). Construct an array containing a single element. +singletonPP :: PA a => a :-> PArray a +singletonPP = closure1' PA.singleton PA.singletonl +{-# INLINE_PA singletonPP #-} + + +-- | O(n). Construct an array of the given size, that maps all elements to the same value. +replicatePP :: PA a => Int :-> a :-> PArray a +replicatePP = closure2' PA.replicate PA.replicatel +{-# INLINE_PA replicatePP #-} + + +-- | O(len result). Append two arrays. +appendPP :: PA a => PArray a :-> PArray a :-> PArray a +appendPP = closure2' PA.append PA.appendl +{-# INLINE_PA appendPP #-} + + +-- | O(len result). Concatenate a nested array. +concatPP :: PA a => PArray (PArray a) :-> PArray a +concatPP = closure1' PA.concat PA.concatl +{-# INLINE_PA concatPP #-} + + +-- Projections ---------------------------------------------------------------- +-- | O(1). Take the number of elements in an array. +lengthPP :: PA a => PArray a :-> Int +lengthPP = closure1' PA.length PA.lengthl +{-# INLINE_PA lengthPP #-} + + +-- | O(1). Lookup a single element from the source array. +indexPP :: PA a => PArray a :-> Int :-> a +indexPP = closure2' PA.index PA.indexl +{-# INLINE_PA indexPP #-} + + +-- | O(len slice). Extract a range of elements from an array. +slicePP :: PA a => Int :-> Int :-> PArray a :-> PArray a +slicePP = closure3' PA.slice PA.slicel +{-# INLINE_PA slicePP #-} + + +-- Traversals ----------------------------------------------------------------- +-- | Apply a worker function to every element of an array. +mapPP :: (PA a, PA b) + => (a :-> b) :-> PArray a :-> PArray b + +mapPP = closure2' mapPP_v mapPP_l +{-# INLINE_PA mapPP #-} + + +mapPP_v :: (PA a, PA b) + => (a :-> b) -> PArray a -> PArray b +mapPP_v f as + = PA.replicate (PA.length as) f $:^ as +{-# INLINE mapPP_v #-} + + +mapPP_l :: (PA a, PA b) + => (PArray (a :-> b)) -> PArray (PArray a) -> PArray (PArray b) +mapPP_l fs ass + = PA.unconcat ass + $ PA.replicates (PA.takeUSegd ass) fs + $:^ PA.concat ass +{-# INLINE mapPP_l #-} + + +-- | Apply a worker function to every pair of two arrays. +zipWithPP + :: (PA a, PA b, PA c) + => (a :-> b :-> c) :-> PArray a :-> PArray b :-> PArray c + +zipWithPP = closure3' zipWithPP_v zipWithPP_l + where + {-# INLINE zipWithPP_v #-} + zipWithPP_v f as bs + = PA.replicate (PA.length as) f $:^ as $:^ bs + + {-# INLINE zipWithPP_l #-} + zipWithPP_l fs ass bss + = PA.unconcat ass + $ PA.replicates (PA.takeUSegd ass) fs + $:^ PA.concat ass + $:^ PA.concat bss +{-# INLINE_PA zipWithPP #-} + + +-- | +crossMapPP + :: (PA a, PA b) + => PArray a :-> (a :-> PArray b) :-> PArray (a, b) + +crossMapPP = closure2' crossMapPP_v crossMapPP_l + where + {-# INLINE crossMapPP_v #-} + crossMapPP_v _ _ + = error "crossMapP: not implemented" + + {-# INLINE crossMapPP_l #-} + crossMapPP_l _ _ + = error "crossMapP: not implemented" + +{-# INLINE_PA crossMapPP #-} + + +-- Filtering ------------------------------------------------------------------ +-- | Extract the elements from an array that match the given predicate. +filterPP :: PA a => (a :-> Bool) :-> PArray a :-> PArray a +{-# INLINE filterPP #-} +filterPP = closure2' filterPP_v filterPP_l + where + {-# INLINE filterPP_v #-} + filterPP_v p xs = PA.pack xs (mapPP_v p xs) + + {-# INLINE filterPP_l #-} + filterPP_l ps xss = PA.packl xss (mapPP_l ps xss) + + +-- Tuple Functions ------------------------------------------------------------ +-- | Zip a pair of arrays into an array of pairs. +zipPP :: (PA a, PA b) => PArray a :-> PArray b :-> PArray (a, b) +zipPP = closure2' PA.zip PA.zipl +{-# INLINE_PA zipPP #-} + + +-- | Unzip an array of pairs into a pair of arrays. +unzipPP :: (PA a, PA b) => PArray (a, b) :-> (PArray a, PArray b) +unzipPP = closure1' PA.unzip PA.unzipl +{-# INLINE_PA unzipPP #-} + diff --git a/Data/Array/Parallel/PArray.hs b/Data/Array/Parallel/PArray.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray.hs @@ -0,0 +1,547 @@ +{-# OPTIONS -fno-spec-constr #-} +{-# LANGUAGE CPP, UndecidableInstances #-} +#include "fusion-phases.h" + +-- | Unvectorised parallel arrays. +-- +-- * These operators may be used directly by unvectorised client programs. +-- +-- * They are also used by the "Data.Array.Parallel.Lifted.Combinators" +-- module to define the closure converted versions that vectorised code +-- uses. +-- +-- * In general, the operators here are all unsafe and don't do bounds checks. +-- The lifted versions also don't check that each of the argument arrays +-- have the same length. + +-- TODO: +-- Export unsafe versions from Data.Array.Parallel.PArray.Unsafe, and ensure +-- this module exports safe wrappers. We want to use the unsafe versions in +-- D.A.P.Lifted.Combinators for performance reasons, but the user facing PArray +-- functions should all be safe. In particular, the vectoriser guarantees +-- that all arrays passed to lifted functions will have the same length, but +-- the user may not obey this restriction. +-- +module Data.Array.Parallel.PArray + ( PArray, PA + , valid + , nf + + -- * Constructors + , empty + , singleton, singletonl + , replicate, replicatel, replicates, replicates' + , append, appendl + , concat, concatl + , unconcat + , nestUSegd + + -- * Projections + , length, lengthl -- length from D.A.P.PArray.PData.Base + , index, indexl + , extract, extracts, extracts' + , slice, slicel + , takeUSegd + + -- * Pack and Combine + , pack, packl + , packByTag + , combine2 + + -- * Enumerations + , enumFromTo, enumFromTol -- from D.A.P.PArray.Scalar + + -- * Tuples + , zip, zipl + , zip3 + , zip4 + , zip5 + , unzip, unzipl + + -- * Conversions + , fromVector, toVector + , fromList, toList + , fromUArray, toUArray -- from D.A.P.PArray.Scalar + , fromUArray2) -- from D.A.P.PArray.Scalar +where +import qualified Data.Array.Parallel.Pretty as T +import Data.Array.Parallel.PArray.PData +import Data.Array.Parallel.PArray.PRepr +import Data.Array.Parallel.PArray.Scalar +import Data.Array.Parallel.PArray.Reference +import GHC.Exts +import Data.Vector (Vector) +import Data.Array.Parallel.Base (Tag) +import qualified Data.Array.Parallel.Array as A +import qualified Data.Array.Parallel.Unlifted as U +import qualified Data.Vector as V +import qualified "dph-lifted-base" Data.Array.Parallel.PArray as R +import qualified "dph-lifted-base" Data.Array.Parallel.PArray.Reference as R + +import qualified Prelude as P +import Prelude hiding + ( length, replicate, concat + , enumFromTo + , zip, zip3, unzip) + + +-- Pretty --------------------------------------------------------------------- +instance PA a => T.PprPhysical (PArray a) where + pprp (PArray n# pdata) + = ( T.text "PArray " T.<+> T.int (I# n#)) + T.$+$ ( T.nest 4 + $ pprpDataPA pdata) + +instance PA a => Similar a where + similar = similarPA + +instance PA a => R.PprPhysical1 a where + pprp1 = pprpPA + + +trace :: String -> a -> a +trace _str x + = x -- Debug.Trace.trace ("! " ++ str) x + +-- Array ----------------------------------------------------------------------- +-- Generic interface to PArrays. +-- +-- NOTE: +-- The toVector conversion is defined by looking up every index instead of +-- using the bulk fromVectorPA function. +-- We do this to convert arrays of type (PArray Void) properly, as although a +-- (PArray Void) has an intrinsic length, a (PData Void) does not. If we try +-- to se the fromVectorPA function at this type we'll just get an `error`. +-- Arrays of type PArray Void aren't visible in the user API, but during +-- debugging we need to be able to print them out with the implied length. +-- +instance PA e => A.Array PArray e where + valid = valid + singleton = singleton + append = append + + length = length + index (PArray _ pdata) ix + = indexPA pdata ix + + toVector arr = V.map (A.index arr) $ V.enumFromTo 0 (A.length arr - 1) + fromVector = fromVector + +-- Operators ================================================================== +-- Each of these operators is wrapped in withRef functions so that we can +-- compare their outputs to the reference implementation. +-- See D.A.P.Reference for details. + + +-- Basics --------------------------------------------------------------------- +instance (Eq a, PA a) => Eq (PArray a) where + (==) (PArray _ xs) (PArray _ ys) = toVectorPA xs == toVectorPA ys + (/=) (PArray _ xs) (PArray _ ys) = toVectorPA xs /= toVectorPA ys + + +-- | Check that an array has a valid internal representation. +valid :: PA a => PArray a -> Bool +valid (PArray n# darr1) + = trace "valid" + $ validPA darr1 + && coversPA True darr1 (I# n#) +{-# INLINE_PA valid #-} + + +-- | Force an array to normal form. +nf :: PA a => PArray a -> () +nf (PArray _ d) + = trace "nf" + $ nfPA d +{-# INLINE_PA nf #-} + + +-- Constructors ---------------------------------------------------------------- +-- | O(1). An empty array. +empty :: PA a => PArray a +empty + = withRef1 "empty" R.empty + $ PArray 0# emptyPA + +{-# INLINE_PA empty #-} + + +-- | O(1). Produce an array containing a single element. +singleton :: PA a => a -> PArray a +singleton x + = withRef1 "singleton" (R.singleton x) + $ PArray 1# (replicatePA 1 x) +{-# INLINE_PA singleton #-} + + +-- | O(n). Produce an array of singleton arrays. +singletonl :: PA a => PArray a -> PArray (PArray a) +singletonl arr + = withRef2 "singletonl" (R.singletonl (toRef1 arr)) + $ replicatel_ (replicate_ (length arr) 1) arr +{-# INLINE_PA singletonl #-} + + +-- | O(n). Define an array of the given size, that maps all elements to the same value. +-- We require the replication count to be > 0 so that it's easier to maintain +-- the validPR invariants for nested arrays. +replicate :: PA a => Int -> a -> PArray a +replicate n x + = withRef1 "replicate" (R.replicate n x) + $ replicate_ n x +{-# INLINE_PA replicate #-} + +replicate_ :: PA a => Int -> a -> PArray a +replicate_ (I# n#) x + = PArray n# (replicatePA (I# n#) x) +{-# INLINE_PA replicate_ #-} + + +-- | O(sum lengths). Lifted replicate. +replicatel :: PA a => PArray Int -> PArray a -> PArray (PArray a) +replicatel reps arr + = withRef2 "replicatel" (R.replicatel (toRef1 reps) (toRef1 arr)) + $ replicatel_ reps arr + +replicatel_ :: PA a => PArray Int -> PArray a -> PArray (PArray a) +replicatel_ (PArray n# (PInt lens)) (PArray _ pdata) + = if n# ==# 0# then empty else + let !segd = U.lengthsToSegd lens + !vsegd = U.promoteSegdToVSegd segd + !pdata' = replicatesPA segd pdata + !pdatas' = singletondPA pdata' + in PArray n# $ mkPNestedPA vsegd pdatas' segd pdata' +{-# INLINE_PA replicatel_ #-} + + +-- | O(sum lengths). Segmented replicate. +replicates :: PA a => U.Segd -> PArray a -> PArray a +replicates segd arr@(PArray _ pdata) + = trace (T.render $ T.text "!!! replicates " T.$+$ T.pprp segd T.$+$ T.pprp arr) + $ withRef1 "replicates" (R.replicates segd (toRef1 arr)) + $ let !(I# n#) = U.elementsSegd segd + in PArray n# $ replicatesPA segd pdata +{-# INLINE_PA replicates #-} + + +-- | O(sum lengths). Wrapper for segmented replicate that takes replication counts +-- and uses them to build the `U.Segd`. +replicates' :: PA a => PArray Int -> PArray a -> PArray a +replicates' (PArray _ (PInt reps)) arr + = trace "replicates'" + $ replicates (U.lengthsToSegd reps) arr +{-# INLINE_PA replicates' #-} + + +-- | Append two arrays. +append :: PA a => PArray a -> PArray a -> PArray a +append arr1@(PArray n1# darr1) arr2@(PArray n2# darr2) + = withRef1 "append" (R.append (toRef1 arr1) (toRef1 arr2)) + $ PArray (n1# +# n2#) (appendPA darr1 darr2) +{-# INLINE_PA append #-} + + +-- | Lifted append. +-- Both arrays must have the same length +appendl :: PA a => PArray (PArray a) -> PArray (PArray a) -> PArray (PArray a) +appendl arr1@(PArray n# pdata1) arr2@(PArray _ pdata2) + = withRef2 "appendl" (R.appendl (toRef2 arr1) (toRef2 arr2)) + $ PArray n# $ appendlPA pdata1 pdata2 +{-# INLINE_PA appendl #-} + + +-- | Concatenate a nested array. +concat :: PA a => PArray (PArray a) -> PArray a +concat arr@(PArray _ darr) + = withRef1 "concat" (R.concat (toRef2 arr)) + $ let darr' = concatPA darr + !(I# n#) = lengthPA darr' + in PArray n# darr' +{-# INLINE_PA concat #-} + + +-- | Lifted concat. +concatl :: PA a => PArray (PArray (PArray a)) -> PArray (PArray a) +concatl arr@(PArray n# pdata1) + = withRef2 "concatl" (R.concatl (toRef3 arr)) + $ PArray n# $ concatlPA pdata1 +{-# INLINE_PA concatl #-} + + +-- | Impose a nesting structure on a flat array +unconcat :: (PA a, PA b) => PArray (PArray a) -> PArray b -> PArray (PArray b) +unconcat (PArray n# pdata1) (PArray _ pdata2) + = trace "! unconcat" + $ PArray n# $ unconcatPA pdata1 pdata2 +{-# INLINE_PA unconcat #-} + + +-- | Create a nested array from a segment descriptor and some flat data. +-- The segment descriptor must represent as many elements as present +-- in the flat data array, else `error` +nestUSegd :: PA a => U.Segd -> PArray a -> PArray (PArray a) +nestUSegd segd (PArray n# pdata) + | U.elementsSegd segd == I# n# + , I# n2# <- U.lengthSegd segd + = PArray n2# + $ PNested (U.promoteSegdToVSegd segd) (singletondPA pdata) segd pdata + + | otherwise + = error $ unlines + [ "Data.Array.Parallel.PArray.nestUSegd: number of elements defined by " + ++ "segment descriptor and data array do not match" + , " length of segment desciptor = " ++ show (U.elementsSegd segd) + , " length of data array = " ++ show (I# n#) ] +{-# INLINE_PA nestUSegd #-} + + +-- Projections --------------------------------------------------------------- +-- | Take the length of some arrays. +lengthl :: PA a => PArray (PArray a) -> PArray Int +lengthl arr@(PArray n# (PNested vsegd _ _ _)) + = withRef1 "lengthl" (R.lengthl (toRef2 arr)) + $ PArray n# $ PInt $ U.takeLengthsOfVSegd vsegd +{-# INLINE_PA lengthl #-} + + +-- | O(1). Lookup a single element from the source array. +index :: PA a => PArray a -> Int -> a +index (PArray _ arr) ix + = trace "index" + $ indexPA arr ix +{-# INLINE_PA index #-} + + +-- | O(len indices). Lookup a several elements from several source arrays +indexl :: PA a => PArray (PArray a) -> PArray Int -> PArray a +indexl (PArray n# darr) (PArray _ ixs) + = trace "indexl" + $ PArray n# (indexlPA darr ixs) +{-# INLINE_PA indexl #-} + + +-- | Extract a range of elements from an array. +extract :: PA a => PArray a -> Int -> Int -> PArray a +extract (PArray _ arr) start len@(I# len#) + = trace "extract" + $ PArray len# (extractPA arr start len) +{-# INLINE_PA extract #-} + + +-- | Segmented extract. +extracts :: PA a => Vector (PArray a) -> U.SSegd -> PArray a +extracts arrs ssegd + = trace "extracts" + $ let pdatas = fromVectordPA $ V.map (\(PArray _ vec) -> vec) arrs + !(I# n#) = (U.sum $ U.lengthsOfSSegd ssegd) + in PArray n# + (extractssPA pdatas ssegd) +{-# INLINE_PA extracts #-} + + +-- | Wrapper for `extracts` that takes arrays of sources, starts and lengths of +-- the segments, and uses these to build the `U.SSegd`. +-- TODO: The lengths of the sources, starts and lengths arrays must be the same, +-- but this is not checked. +-- All sourceids must point to valid data arrays. +-- Segments must be within their corresponding source array. +extracts' + :: PA a + => Vector (PArray a) + -> PArray Int -- ^ id of source array for each segment. + -> PArray Int -- ^ starting index of each segment in its source array. + -> PArray Int -- ^ length of each segment. + -> PArray a +extracts' arrs (PArray _ (PInt sources)) (PArray _ (PInt starts)) (PArray _ (PInt lengths)) + = trace "extracts'" + $ let segd = U.lengthsToSegd lengths + ssegd = U.mkSSegd starts sources segd + in extracts arrs ssegd +{-# INLINE_PA extracts' #-} + + +-- | Extract a range of elements from an arrary. +-- Like `extract` but with the parameters in a different order. +slice :: PA a => Int -> Int -> PArray a -> PArray a +slice start len@(I# len#) (PArray _ darr) + = trace "slice" + $ PArray len# (extractPA darr start len) +{-# INLINE_PA slice #-} + + +-- | Extract some slices from some arrays. +-- The arrays of starting indices and lengths must themselves +-- have the same length. +slicel :: PA a => PArray Int -> PArray Int -> PArray (PArray a) -> PArray (PArray a) +slicel (PArray n# sliceStarts) (PArray _ sliceLens) (PArray _ darr) + = trace "slicel" + $ PArray n# (slicelPA sliceStarts sliceLens darr) +{-# INLINE_PA slicel #-} + + +-- | Take the segment descriptor from a nested array and demote it to a +-- plain Segd. This is unsafe because it can cause index space overflow. +takeUSegd :: PArray (PArray a) -> U.Segd +takeUSegd (PArray _ pdata) + = trace "takeUSegd" + $ takeSegdPD pdata +{-# INLINE_PA takeUSegd #-} + + +-- Pack and Combine ----------------------------------------------------------- +-- | Select the elements of an array that have their tag set to True. +pack :: PA a => PArray a -> PArray Bool -> PArray a +pack arr@(PArray _ xs) flags@(PArray _ (PBool sel2)) + = withRef1 "pack" (R.pack (toRef1 arr) (toRef1 flags)) + $ let darr' = packByTagPA xs (U.tagsSel2 sel2) 1 + + -- The selector knows how many elements are set to '1', + -- so we can use this for the length of the resulting array. + !(I# m#) = U.elementsSel2_1 sel2 + + in PArray m# darr' +{-# INLINE_PA pack #-} + + +-- | Lifted pack. +packl :: PA a => PArray (PArray a) -> PArray (PArray Bool) -> PArray (PArray a) +packl xss@(PArray n# xdata@(PNested _ _ segd _)) + fss@(PArray _ fdata) + = withRef2 "packl" (R.packl (toRef2 xss) (toRef2 fss)) + $ let + -- Concatenate both arrays to get the flat data. + -- Although the virtual segmentation should be the same, + -- the physical segmentation of both arrays may be different. + xdata_flat = concatPA xdata + PBool sel = concatPA fdata + tags = U.tagsSel2 sel + + -- Count how many elements go into each segment. + segd' = U.lengthsToSegd $ U.count_s segd tags 1 + + -- Build the result array + vsegd' = U.promoteSegdToVSegd segd' + flat' = packByTagPA xdata_flat tags 1 + pdatas' = singletondPA flat' + + in PArray n# (PNested vsegd' pdatas' segd' flat') +{-# INLINE_PA packl #-} + + +-- | Filter an array based on some tags. +packByTag :: PA a => PArray a -> U.Array Tag -> Tag -> PArray a +packByTag arr@(PArray _ darr) tags tag + = withRef1 "packByTag" (R.packByTag (toRef1 arr) tags tag) + $ let darr' = packByTagPA darr tags tag + !(I# n#) = lengthPA darr' + in PArray n# darr' + +{-# INLINE_PA packByTag #-} + + +-- | Combine two arrays based on a selector. +combine2 :: forall a. PA a => U.Sel2 -> PArray a -> PArray a -> PArray a +combine2 sel arr1@(PArray _ darr1) arr2@(PArray _ darr2) + = withRef1 "combine2" (R.combine2 sel (toRef1 arr1) (toRef1 arr2)) + $ let darr' = combine2PA sel darr1 darr2 + !(I# n#) = lengthPA darr' + in PArray n# darr' +{-# INLINE_PA combine2 #-} + + +-- Tuples --------------------------------------------------------------------- +-- | O(1). Zip a pair of arrays into an array of pairs. +-- The two arrays must have the same length, else `error`. +zip :: PArray a -> PArray b -> PArray (a, b) +zip (PArray n# pdata1) (PArray _ pdata2) + = trace "zip" + $ PArray n# $ zipPD pdata1 pdata2 +{-# INLINE_PA zip #-} + + +-- | Lifted zip. +zipl :: (PA a, PA b) + => PArray (PArray a) -> PArray (PArray b) -> PArray (PArray (a, b)) +zipl (PArray n# xs) (PArray _ ys) + = trace "zipl" + $ PArray n# $ ziplPA xs ys +{-# INLINE_PA zipl #-} + + +-- | O(1). Zip three arrays. +-- All arrays must have the same length, else `error`. +zip3 :: PArray a -> PArray b -> PArray c -> PArray (a, b, c) +zip3 (PArray n# pdata1) (PArray _ pdata2) (PArray _ pdata3) + = trace "zip3" + $ PArray n# $ zip3PD pdata1 pdata2 pdata3 +{-# INLINE_PA zip3 #-} + + +-- | O(1). Zip four arrays. +-- All arrays must have the same length, else `error`. +zip4 :: PArray a -> PArray b -> PArray c -> PArray d -> PArray (a, b, c, d) +zip4 (PArray n# pdata1) (PArray _ pdata2) (PArray _ pdata3) (PArray _ pdata4) + = trace "zip4" + $ PArray n# $ zip4PD pdata1 pdata2 pdata3 pdata4 +{-# INLINE_PA zip4 #-} + + +-- | O(1). Zip five arrays. +-- All arrays must have the same length, else `error`. +zip5 :: PArray a -> PArray b -> PArray c -> PArray d -> PArray e -> PArray (a, b, c, d, e) +zip5 (PArray n# pdata1) (PArray _ pdata2) (PArray _ pdata3) (PArray _ pdata4) (PArray _ pdata5) + = trace "zip5" + $ PArray n# $ zip5PD pdata1 pdata2 pdata3 pdata4 pdata5 +{-# INLINE_PA zip5 #-} + + +-- | O(1). Unzip an array of pairs into a pair of arrays. +unzip :: PArray (a, b) -> (PArray a, PArray b) +unzip (PArray n# (PTuple2 xs ys)) + = trace "unzip" + $ (PArray n# xs, PArray n# ys) +{-# INLINE_PA unzip #-} + + +-- | Lifted unzip +unzipl :: PArray (PArray (a, b)) -> PArray (PArray a, PArray b) +unzipl (PArray n# pdata) + = trace "unzipl" + $ PArray n# $ unziplPD pdata +{-# INLINE_PA unzipl #-} + + +-- Conversions ---------------------------------------------------------------- +-- | Convert a `Vector` to a `PArray` +fromVector :: PA a => Vector a -> PArray a +fromVector vec + = trace "fromVector" + $ let !(I# n#) = V.length vec + in PArray n# (fromVectorPA vec) +{-# INLINE_PA fromVector #-} + + +-- | Convert a `PArray` to a `Vector` +toVector :: PA a => PArray a -> Vector a +toVector (PArray _ arr) + = trace "toVector" + $ toVectorPA arr +{-# INLINE_PA toVector #-} + + +-- | Convert a list to a `PArray`. +fromList :: PA a => [a] -> PArray a +fromList xx + = trace "fromList" + $ let !(I# n#) = P.length xx + in PArray n# (fromVectorPA $ V.fromList xx) +{-# INLINE_PA fromList #-} + + +-- | Convert a `PArray` to a list. +toList :: PA a => PArray a -> [a] +toList (PArray _ arr) + = trace "toList" + $ V.toList $ toVectorPA arr +{-# INLINE_PA toList #-} + diff --git a/Data/Array/Parallel/PArray/PData.hs b/Data/Array/Parallel/PArray/PData.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PData.hs @@ -0,0 +1,53 @@ + +-- | Parallel array data. +-- +-- This is an interface onto the internal array types and operators defined +-- by the library, and should not normally be used by client programs. +module Data.Array.Parallel.PArray.PData + ( -- * Parallel array types + PArray (..), PData(..), PDatas(..) + , length, takeData + + -- * PR (Parallel Representation) + , PR (..) + + -- * Extra conversions + , fromListPR + , toListPR + + -- * Nested arrays + , module Data.Array.Parallel.PArray.PData.Nested + + -- * Tuple arrays + , module Data.Array.Parallel.PArray.PData.Tuple2 + , module Data.Array.Parallel.PArray.PData.Tuple3 + , module Data.Array.Parallel.PArray.PData.Tuple4 + , module Data.Array.Parallel.PArray.PData.Tuple5) +where +import Data.Array.Parallel.PArray.PData.Base +import Data.Array.Parallel.PArray.PData.Wrap +import Data.Array.Parallel.PArray.PData.Nested +import Data.Array.Parallel.PArray.PData.Tuple2 +import Data.Array.Parallel.PArray.PData.Tuple3 +import Data.Array.Parallel.PArray.PData.Tuple4 +import Data.Array.Parallel.PArray.PData.Tuple5 +import Data.Array.Parallel.PArray.PData.Void () +import Data.Array.Parallel.PArray.PData.Unit () +import Data.Array.Parallel.PArray.PData.Int () +import Data.Array.Parallel.PArray.PData.Word8 () +import Data.Array.Parallel.PArray.PData.Double () +import Data.Array.Parallel.PArray.PData.Sum2 () +import Data.Array.Parallel.PArray.PRepr.Instances () +import qualified Data.Vector as V +import Prelude hiding (length) + + +-- | Convert a list to a PData. +fromListPR :: PR a => [a] -> PData a +fromListPR = fromVectorPR . V.fromList + + +-- | Convert a PData to a list. +toListPR :: PR a => PData a -> [a] +toListPR = V.toList . toVectorPR + diff --git a/Data/Array/Parallel/PArray/PData/Base.hs b/Data/Array/Parallel/PArray/PData/Base.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PData/Base.hs @@ -0,0 +1,273 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP, UndecidableInstances, ParallelListComp #-} +-- Undeciable instances only need for derived Show instance +#include "fusion-phases.h" + +-- | Parallel array types and the PR class that works on the generic +-- representation of array data. +module Data.Array.Parallel.PArray.PData.Base + ( -- * Parallel Array types. + PArray(..) + , length, takeData + + , PR (..) + , PData(..), PDatas(..) + , bpermutePR) +where +import Data.Array.Parallel.Pretty +import GHC.Exts +import SpecConstr () +import Data.Vector (Vector) +import Data.Array.Parallel.Base (Tag) +import qualified Data.Array.Parallel.Unlifted as U +import qualified Data.Vector as V +import Prelude hiding (length) + +-- PArray --------------------------------------------------------------------- +-- | A parallel array consisting of a length field and some array data. + +-- IMPORTANT: +-- The vectoriser requires the PArray data constructor to have this specific +-- form, because it builds them explicitly. Specifically, the array length +-- must be unboxed. +-- +-- TODO: Why do we need the NoSpecConstr annotation? +-- +{-# ANN type PArray NoSpecConstr #-} +data PArray a + = PArray Int# (PData a) + +-- | Take the length field of a `PArray`. +{-# INLINE_PA length #-} +length :: PArray a -> Int +length (PArray n# _) = (I# n#) + + +-- | Take the `PData` of a `PArray`. +{-# INLINE_PA takeData #-} +takeData :: PArray a -> PData a +takeData (PArray _ d) = d + + +-- Parallel array data -------------------------------------------------------- +-- | A chunk of parallel array data with a linear index space. +-- +-- In contrast to a `PArray`, a `PData` may not have a fixed length, and its +-- elements may have been converted to a generic representation. Whereas a +-- `PArray` is the \"user view\" of an array, a `PData` is a type only +-- used internally to the library. + +-- An example of an array with no length is PData Void. We can index this +-- at an arbitrary position, and always get a 'void' element back. +-- +{-# ANN type PData NoSpecConstr #-} +data family PData a + +-- | Several chunks of parallel array data. +-- +-- Although a `PArray` of atomic type such as `Int` only contains a +-- single `PData` chunk, nested arrays may contain several, which we +-- wrap up into a `PDatas`. +{-# ANN type PDatas NoSpecConstr #-} +data family PDatas a + + +-- Put these here to break an import loop. +data instance PData Int + = PInt (U.Array Int) + +data instance PDatas Int + = PInts (U.Arrays Int) + + +-- PR ------------------------------------------------------------------------- +-- | The PR (Parallel Representation) class holds primitive array operators that +-- work on our generic representation of data. +-- +-- There are instances for all atomic types such as `Int` and `Double`, tuples, +-- nested arrays `PData (PArray a)` and for the generic types we used to represent +-- user level algebraic data, `Sum2` and `Wrap` and `Void`. All array data +-- is converted to this fixed set of types. +-- +-- TODO: refactor to change PData Int to U.Array Int, +-- there's not need to wrap an extra PData constructor around these arrays, +-- and the type of bpermute is different than the others. +class PR a where + + -- House Keeping ------------------------------ + -- These methods are helpful for debugging, but we don't want their + -- associated type classes as superclasses of PR. + + -- | (debugging) Check that an array has a well formed representation. + -- This should only return `False` where there is a bug in the library. + validPR :: PData a -> Bool + + -- | (debugging) Ensure an array is fully evaluted. + nfPR :: PData a -> () + + -- | (debugging) Weak equality of contained elements. + -- + -- Returns `True` for functions of the same type. In the case of nested arrays, + -- returns `True` if the array defines the same set of elements, but does not + -- care about the exact form of the segement descriptors. + similarPR :: a -> a -> Bool + + -- | (debugging) Check that an index is within an array. + -- + -- Arrays containing `Void` elements don't have a fixed length, and return + -- `Void` for all indices. If the array does have a fixed length, and the + -- flag is true, then we allow the index to be equal to this length, as + -- well as less than it. + coversPR :: Bool -> PData a -> Int -> Bool + + -- | (debugging) Pretty print the physical representation of an element. + pprpPR :: a -> Doc + + -- | (debugging) Pretty print the physical representation of some array data. + pprpDataPR :: PData a -> Doc + + + -- Constructors ------------------------------- + -- | Produce an empty array with size zero. + emptyPR :: PData a + + -- | O(n). Define an array of the given size, that maps all elements to the + -- same value. + -- + -- We require the replication count to be > 0 so that it's easier to + -- maintain the `validPR` invariants for nested arrays. + replicatePR :: Int -> a -> PData a + + -- | O(sum lengths). Segmented replicate. + -- + -- Given a Segment Descriptor (Segd), replicate each each element in the + -- array according to the length of the corrsponding segment. + -- The array data must define at least as many elements as there are segments + -- in the descriptor. + + -- TODO: This takes a whole Segd instead of just the lengths. If the Segd knew + -- that there were no zero length segments then we could implement this + -- more efficiently in the nested case case. If there are no zeros, then + -- all psegs in the result are reachable from the vsegs, and we wouldn't + -- need to pack them after the replicate. + -- + replicatesPR :: U.Segd -> PData a -> PData a + + -- | Append two arrays. + appendPR :: PData a -> PData a -> PData a + + -- | Segmented append. + -- + -- The first descriptor defines the segmentation of the result, + -- and the others define the segmentation of each source array. + appendsPR :: U.Segd + -> U.Segd -> PData a + -> U.Segd -> PData a + -> PData a + + + -- Projections -------------------------------- + -- | O(1). Get the length of an array, if it has one. + -- + -- Applying this function to an array of `Void` will yield `error`, as + -- these arrays have no fixed length. To check array bounds, use the + -- `coversPR` method instead, as that is a total function. + lengthPR :: PData a -> Int + + -- | O(1). Retrieve a single element from a single array. + indexPR :: PData a -> Int -> a + + -- | O(1). Shared indexing. + -- Retrieve several elements from several chunks of array data, + -- given the chunkid and index in that chunk for each element. + indexsPR :: PDatas a -> U.Array (Int, Int) -> PData a + + -- | O(1). Shared indexing + indexvsPR :: PDatas a -> U.VSegd -> U.Array (Int, Int) -> PData a + + -- | O(slice len). Extract a slice of elements from an array, + -- given the starting index and length of the slice. + extractPR :: PData a -> Int -> Int -> PData a + + -- | O(sum seglens). Shared extract. + -- Extract several slices from several source arrays. + -- + -- The Scattered Segment Descriptor (`SSegd`) describes where to get each + -- slice, and all slices are concatenated together into the result. + extractssPR :: PDatas a -> U.SSegd -> PData a + + -- | O(sum seglens). Shared extract. + -- Extract several slices from several source arrays. + -- TODO: we're refactoring the library so functions use the VSeg form directly, + -- instead of going via a SSegd. + extractvsPR :: PDatas a -> U.VSegd -> PData a + extractvsPR pdatas vsegd + = extractssPR pdatas (U.unsafeDemoteToSSegdOfVSegd vsegd) + + -- Pack and Combine --------------------------- + -- | Select elements of an array that have their corresponding tag set to + -- the given value. + -- + -- The data array must define at least as many elements as the length + -- of the tags array. + packByTagPR :: PData a -> U.Array Tag -> Tag -> PData a + + -- | Combine two arrays based on a selector. + -- + -- See the documentation for selectors in the dph-prim-seq library + -- for how this works. + combine2PR :: U.Sel2 -> PData a -> PData a -> PData a + + + -- Conversions -------------------------------- + -- | Convert a boxed vector to an array. + fromVectorPR :: Vector a -> PData a + + -- | Convert an array to a boxed vector. + toVectorPR :: PData a -> Vector a + + + -- PDatas ------------------------------------- + -- | O(1). Yield an empty collection of `PData`. + emptydPR :: PDatas a + + -- | O(1). Yield a singleton collection of `PData`. + singletondPR :: PData a -> PDatas a + + -- | O(1). Yield how many `PData` are in the collection. + lengthdPR :: PDatas a -> Int + + -- | O(1). Lookup a `PData` from a collection. + indexdPR :: PDatas a -> Int -> PData a + + -- | O(n). Append two collections of `PData`. + appenddPR :: PDatas a -> PDatas a -> PDatas a + + -- | O(n). Convert a vector of `PData` to a `PDatas`. + fromVectordPR :: V.Vector (PData a) -> PDatas a + + -- | O(n). Convert a `PDatas` to a vector of `PData`. + toVectordPR :: PDatas a -> V.Vector (PData a) + + + +-- | O(len indices) Backwards permutation. +-- Retrieve several elements from a single array. +bpermutePR :: PR a => PData a -> U.Array Int -> PData a +bpermutePR pdata ixs + = indexsPR (singletondPR pdata) + (U.zip (U.replicate (U.length ixs) 0) + ixs) + + +-- Pretty --------------------------------------------------------------------- +instance PR a => PprPhysical (PData a) where + pprp = pprpDataPR + +instance PR a => PprPhysical (PDatas a) where + pprp pdatas + = vcat + $ [ int n <> colon <> text " " <> pprpDataPR pd + | n <- [0..] + | pd <- V.toList $ toVectordPR pdatas] + diff --git a/Data/Array/Parallel/PArray/PData/Double.hs b/Data/Array/Parallel/PArray/PData/Double.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PData/Double.hs @@ -0,0 +1,167 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | PR instance for Doubles. +module Data.Array.Parallel.PArray.PData.Double + ( PData (..) + , PDatas(..)) +where +import Data.Array.Parallel.Pretty +import Data.Array.Parallel.PArray.PData.Base +import Data.Array.Parallel.PArray.PData.Nested +import qualified Data.Array.Parallel.Unlifted as U +import qualified Data.Vector as V + + +------------------------------------------------------------------------------- +data instance PData Double + = PDouble (U.Array Double) + +data instance PDatas Double + = PDoubles (U.Arrays Double) + + +-- PR ------------------------------------------------------------------------- +instance PR Double where + + {-# NOINLINE validPR #-} + validPR _ + = True + + {-# NOINLINE nfPR #-} + nfPR (PDouble xx) + = xx `seq` () + + {-# NOINLINE similarPR #-} + similarPR = (==) + + {-# NOINLINE coversPR #-} + coversPR weak (PDouble uarr) ix + | weak = ix <= U.length uarr + | otherwise = ix < U.length uarr + + {-# NOINLINE pprpPR #-} + pprpPR d + = double d + + {-# NOINLINE pprpDataPR #-} + pprpDataPR (PDouble vec) + = text "PDouble" + <+> text (show $ U.toList vec) + + + -- Constructors ------------------------------- + {-# INLINE_PDATA emptyPR #-} + emptyPR + = PDouble U.empty + + {-# INLINE_PDATA replicatePR #-} + replicatePR len x + = PDouble $ U.replicate len x + + {-# INLINE_PDATA replicatesPR #-} + replicatesPR segd (PDouble arr) + = PDouble $ U.replicate_s segd arr + + {-# INLINE_PDATA appendPR #-} + appendPR (PDouble arr1) (PDouble arr2) + = PDouble $ arr1 U.+:+ arr2 + + {-# INLINE_PDATA appendsPR #-} + appendsPR segdResult segd1 (PDouble arr1) segd2 (PDouble arr2) + = PDouble $ U.append_s segdResult segd1 arr1 segd2 arr2 + + + -- Projections -------------------------------- + {-# INLINE_PDATA lengthPR #-} + lengthPR (PDouble uarr) + = U.length uarr + + {-# INLINE_PDATA indexPR #-} + indexPR (PDouble arr) ix + = U.index "indexPR[Double]" arr ix + + {-# INLINE_PDATA indexsPR #-} + indexsPR (PDoubles pvecs) srcixs + = PDouble $ U.map (\(src, ix) -> U.unsafeIndex2s pvecs src ix) srcixs + + {-# INLINE_PDATA indexvsPR #-} + indexvsPR (PDoubles arrs) vsegd srcixs + = PDouble $ U.indexs_avs arrs vsegd srcixs + + {-# INLINE_PDATA extractPR #-} + extractPR (PDouble arr) start len + = PDouble $ U.extract arr start len + + {-# INLINE_PDATA extractssPR #-} + extractssPR (PDoubles arrs) ssegd + = PDouble $ U.extracts_ass ssegd arrs + + {-# INLINE_PDATA extractvsPR #-} + extractvsPR (PDoubles arrs) vsegd + = PDouble $ U.extracts_avs vsegd arrs + + + -- Pack and Combine --------------------------- + {-# NOINLINE packByTagPR #-} + packByTagPR (PDouble arr1) arrTags tag + = PDouble $ U.packByTag arr1 arrTags tag + + {-# NOINLINE combine2PR #-} + combine2PR sel (PDouble arr1) (PDouble arr2) + = PDouble $ U.combine2 (U.tagsSel2 sel) + (U.repSel2 sel) + arr1 arr2 + + + -- Conversions -------------------------------- + {-# NOINLINE fromVectorPR #-} + fromVectorPR xx + = PDouble (U.fromList $ V.toList xx) + + {-# NOINLINE toVectorPR #-} + toVectorPR (PDouble arr) + = V.fromList $ U.toList arr + + + -- PDatas ------------------------------------- + {-# INLINE_PDATA emptydPR #-} + emptydPR + = PDoubles $ U.emptys + + {-# INLINE_PDATA singletondPR #-} + singletondPR (PDouble pdata) + = PDoubles $ U.singletons pdata + + {-# INLINE_PDATA lengthdPR #-} + lengthdPR (PDoubles vec) + = U.lengths vec + + {-# INLINE_PDATA indexdPR #-} + indexdPR (PDoubles vec) ix + = PDouble $ vec `U.unsafeIndexs` ix + + {-# INLINE_PDATA appenddPR #-} + appenddPR (PDoubles xs) (PDoubles ys) + = PDoubles $ xs `U.appends` ys + + {-# NOINLINE fromVectordPR #-} + fromVectordPR pdatas + = PDoubles + $ U.fromVectors + $ V.map (\(PDouble vec) -> vec) pdatas + + {-# NOINLINE toVectordPR #-} + toVectordPR (PDoubles vec) + = V.map PDouble $ U.toVectors vec + + +-- Show ----------------------------------------------------------------------- +deriving instance Show (PData Double) +deriving instance Show (PDatas Double) + +instance PprVirtual (PData Double) where + pprv (PDouble vec) + = text (show $ U.toList vec) + diff --git a/Data/Array/Parallel/PArray/PData/Int.hs b/Data/Array/Parallel/PArray/PData/Int.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PData/Int.hs @@ -0,0 +1,159 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | PR instance for Ints +module Data.Array.Parallel.PArray.PData.Int () where +import Data.Array.Parallel.PArray.PData.Base +import qualified Data.Array.Parallel.Unlifted as U +import qualified Data.Vector as V +import Text.PrettyPrint +import Prelude as P +import Data.Array.Parallel.Pretty + + +-- PR ------------------------------------------------------------------------- +instance PR Int where + + {-# NOINLINE validPR #-} + validPR _ + = True + + {-# NOINLINE nfPR #-} + nfPR (PInt xx) + = xx `seq` () + + {-# NOINLINE similarPR #-} + similarPR = (==) + + {-# NOINLINE coversPR #-} + coversPR weak (PInt uarr) ix + | weak = ix <= U.length uarr + | otherwise = ix < U.length uarr + + {-# NOINLINE pprpPR #-} + pprpPR i + = int i + + {-# NOINLINE pprpDataPR #-} + pprpDataPR (PInt uarr) + = text "PInt" <+> pprp uarr + + + -- Constructors ------------------------------- + {-# INLINE_PDATA emptyPR #-} + emptyPR + = PInt U.empty + + {-# INLINE_PDATA replicatePR #-} + replicatePR len x + = PInt (U.replicate len x) + + {-# INLINE_PDATA replicatesPR #-} + replicatesPR segd (PInt arr) + = PInt (U.replicate_s segd arr) + + {-# INLINE_PDATA appendPR #-} + appendPR (PInt arr1) (PInt arr2) + = PInt $ arr1 U.+:+ arr2 + + {-# INLINE_PDATA appendsPR #-} + appendsPR segdResult segd1 (PInt arr1) segd2 (PInt arr2) + = PInt $ U.append_s segdResult segd1 arr1 segd2 arr2 + + + -- Projections -------------------------------- + {-# INLINE_PDATA lengthPR #-} + lengthPR (PInt uarr) + = U.length uarr + + {-# INLINE_PDATA indexPR #-} + indexPR (PInt uarr) ix + = U.index "indexPR[Int]" uarr ix + + {-# INLINE_PDATA indexsPR #-} + indexsPR (PInts pvecs) srcixs + = PInt $ U.map (\(src, ix) -> U.unsafeIndex2s pvecs src ix) srcixs + + {-# INLINE_PDATA indexvsPR #-} + indexvsPR (PInts arrs) vsegd srcixs + = PInt $ U.indexs_avs arrs vsegd srcixs + + {-# INLINE_PDATA extractPR #-} + extractPR (PInt arr) start len + = PInt $ U.extract arr start len + + {-# INLINE_PDATA extractssPR #-} + extractssPR (PInts arrs) ssegd + = PInt $ U.extracts_ass ssegd arrs + + {-# INLINE_PDATA extractvsPR #-} + extractvsPR (PInts arrs) vsegd + = PInt $ U.extracts_avs vsegd arrs + + + -- Pack and Combine --------------------------- + {-# NOINLINE packByTagPR #-} + packByTagPR (PInt arr1) arrTags tag + = PInt $ U.packByTag arr1 arrTags tag + + {-# NOINLINE combine2PR #-} + combine2PR sel (PInt arr1) (PInt arr2) + = PInt $ U.combine2 (U.tagsSel2 sel) + (U.repSel2 sel) + arr1 arr2 + + + -- Conversions -------------------------------- + {-# NOINLINE fromVectorPR #-} + fromVectorPR xx + = PInt $U.fromList $ V.toList xx + + {-# NOINLINE toVectorPR #-} + toVectorPR (PInt arr) + = V.fromList $ U.toList arr + + + -- PDatas ------------------------------------- + {-# INLINE_PDATA emptydPR #-} + emptydPR + = PInts $ U.emptys + + {-# INLINE_PDATA singletondPR #-} + singletondPR (PInt arr) + = PInts $ U.singletons arr + + {-# INLINE_PDATA lengthdPR #-} + lengthdPR (PInts arrs) + = U.lengths arrs + + {-# INLINE_PDATA indexdPR #-} + indexdPR (PInts arrs) ix + = PInt $ arrs `U.unsafeIndexs` ix + + {-# INLINE_PDATA appenddPR #-} + appenddPR (PInts xs) (PInts ys) + = PInts $ xs `U.appends` ys + + {-# NOINLINE fromVectordPR #-} + fromVectordPR pdatas + = PInts + $ U.fromVectors + $ V.map (\(PInt vec) -> vec) pdatas + + {-# NOINLINE toVectordPR #-} + toVectordPR (PInts vec) + = V.map PInt $ U.toVectors vec + + +-- Show ----------------------------------------------------------------------- +deriving instance Show (PData Int) +deriving instance Show (PDatas Int) + +instance PprPhysical (U.Array Int) where + pprp uarr + = text (show $ U.toList uarr) + +instance PprVirtual (PData Int) where + pprv (PInt vec) + = text (show $ U.toList vec) diff --git a/Data/Array/Parallel/PArray/PData/Nested.hs b/Data/Array/Parallel/PArray/PData/Nested.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PData/Nested.hs @@ -0,0 +1,718 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP, UndecidableInstances, ParallelListComp #-} +{-# OPTIONS -fno-spec-constr #-} +#include "fusion-phases.h" + +-- | PR instance for nested arrays. +module Data.Array.Parallel.PArray.PData.Nested + ( PData(..) + , PDatas(..) + , mkPNested + , concatPR, concatlPR + , flattenPR, takeSegdPD + , unconcatPR + , appendlPR + , indexlPR + , slicelPR + , extractvs_delay) +where +import Data.Array.Parallel.Base +import Data.Array.Parallel.Pretty +import Data.Array.Parallel.PArray.PData.Base as PA +import qualified Data.IntSet as IS +import qualified Data.Array.Parallel.Unlifted as U +import qualified Data.Vector as V +import GHC.Exts +import System.IO.Unsafe + + +-- Nested arrays -------------------------------------------------------------- +data instance PData (PArray a) + = PNested + { pnested_uvsegd :: U.VSegd + -- ^ Virtual segmentation descriptor. + -- Defines a virtual nested array based on physical data. + + , pnested_psegdata :: PDatas a + -- ^ Chunks of array data, where each chunk has a linear index space. + + , pnested_segd :: U.Segd -- LAZY FIELD + -- ^ A demoted version of the VSegd. + -- If the function that creates the array already has the plain Segd, + -- then it should stash it here, otherwise build a thunk that makes it. + + , pnested_flat :: PData a -- LAZY FIELD + -- ^ A pre-concatenated version of the array. + -- If the function that creates the array already has a flat form, + -- then it should stash it here, otherwise build a thunk that makes it. + } + + +-- TODO: should we unpack the vsegd fields here? +data instance PDatas (PArray a) + = PNesteds (V.Vector (PData (PArray a))) + + +-- | Construct a nested array. +mkPNested :: PR a + => U.VSegd -> PDatas a + -> U.Segd -> PData a + -> PData (PArray a) +mkPNested = PNested +{-# INLINE_PDATA mkPNested #-} + + +-- Projections ---------------------------------------------------------------- +-- These functions take concatenated forms of the vsegd and array data from +-- the representation of the nested array. Although the projections themselves +-- are O(1), they could return thunks. + +-- | Concatenate a nested array. +concatPR :: PR a => PData (PArray a) -> PData a +concatPR (PNested _ _ _ flat) + = flat +{-# INLINE concatPR #-} + +-- | Take the segment descriptor from a nested array and demote it to a +-- plain Segd. +takeSegdPD :: PData (PArray a) -> U.Segd +takeSegdPD (PNested _ _ segd _) + = segd +{-# INLINE_PDATA takeSegdPD #-} + +-- | Flatten a nested array, yielding a plain segment descriptor and +-- concatenated data. +-- +flattenPR :: PR a => PData (PArray a) -> (U.Segd, PData a) +flattenPR (PNested _ _ segd flat) + = (segd, flat) +{-# INLINE_PDATA flattenPR #-} + + +-- PR Instances --------------------------------------------------------------- +instance U.Elt (Int, Int, Int) + +instance PR a => PR (PArray a) where + -- TODO: make this check all sub arrays as well + -- TODO: ensure that all psegdata arrays are referenced from some psegsrc. + -- TODO: shift segd checks into associated modules. + {-# NOINLINE validPR #-} + validPR (PNested vsegd pdatas _ _) + = let vsegids = U.takeVSegidsOfVSegd vsegd + ssegd = U.takeSSegdOfVSegd vsegd + pseglens = U.lengthsOfSSegd ssegd + psegstarts = U.startsOfSSegd ssegd + psegsrcs = U.sourcesOfSSegd ssegd + + -- The lengths of the pseglens, psegstarts and psegsrcs fields must all be the same + fieldLensOK + = validBool "nested array field lengths not identical" + $ and + [ U.length psegstarts == U.length pseglens + , U.length psegsrcs == U.length pseglens ] + + -- Every vseg must reference a valid pseg. + vsegsRefOK + = validBool "nested array vseg doesn't ref pseg" + $ U.and + $ U.map (\vseg -> vseg < U.length pseglens) vsegids + + -- Every pseg source id must point to a flat data array + psegsrcsRefOK + = validBool "nested array psegsrc doesn't ref flat array" + $ U.and + $ U.map (\srcid -> srcid < lengthdPR pdatas) psegsrcs + + -- Every physical segment must be a valid slice of the corresponding flat array. + -- + -- We allow psegs with len 0, start 0 even if the flat array is empty. + -- This occurs with [ [] ]. + -- + -- As a generalistion of above, we allow segments with len 0, start <= srclen. + -- This occurs when there is an empty array as the last segment + -- For example: + -- [ [5, 4, 3, 2] [ ] ]. + -- PNested vsegids: [0,1] + -- pseglens: [4,0] + -- psegstarts: [0,4] -- last '4' here is <= length of flat array + -- psegsrcs: [0,0] + -- PInt [5, 4, 3, 2] + -- + psegSlicesOK + = validBool "nested array pseg slices are invalid" + $ U.and + $ U.zipWith3 + (\len start srcid + -> let pdata = pdatas `indexdPR` srcid + in and [ coversPR (len == 0) pdata start + , coversPR True pdata (start + len) ]) + pseglens psegstarts psegsrcs + + -- Every pseg must be referenced by some vseg. + vsegs = IS.fromList $ U.toList vsegids + psegsReffedOK + = validBool "nested array pseg not reffed by vseg" + $ (U.length pseglens == 0) + || (U.and $ U.map (flip IS.member vsegs) + $ U.enumFromTo 0 (U.length pseglens - 1)) + + in unsafePerformIO + $ do {-print fieldLensOK + print vsegsRefOK + print psegsrcsRefOK + print psegSlicesOK + print psegsReffedOK-} + return $ + and [ fieldLensOK + , vsegsRefOK + , psegsrcsRefOK + , psegSlicesOK + , psegsReffedOK ] + + {-# NOINLINE nfPR #-} + nfPR = error "nfPR[PArray]: not defined yet" + + + {-# NOINLINE similarPR #-} + similarPR (PArray _ pdata1) (PArray _ pdata2) + = V.and $ V.zipWith similarPR + (toVectorPR pdata1) + (toVectorPR pdata2) + + + {-# NOINLINE coversPR #-} + coversPR weak (PNested vsegd _ _ _) ix + | weak = ix <= (U.length $ U.takeVSegidsOfVSegd vsegd) + | otherwise = ix < (U.length $ U.takeVSegidsOfVSegd vsegd) + + {-# NOINLINE pprpPR #-} + pprpPR (PArray n# pdata) + = (text "PArray " <+> int (I# n#)) + $+$ ( nest 4 + $ pprpDataPR pdata) + + {-# NOINLINE pprpDataPR #-} + pprpDataPR (PNested vsegd pdatas _ _) + = text "PNested" + $+$ ( nest 4 + $ pprp vsegd $$ pprp pdatas) + + + -- Constructors ----------------------------------------- + {-# INLINE_PDATA emptyPR #-} + emptyPR = PNested U.emptyVSegd emptydPR U.emptySegd emptyPR + + + -- When replicating an array we use the source as the single physical + -- segment, then point all the virtual segments to it. + {-# INLINE_PDATA replicatePR #-} + replicatePR c (PArray n# pdata) + = checkNotEmpty "replicatePR[PArray]" c + $ let -- All virtual segments point to the same physical segment. + vsegd = U.replicatedVSegd (I# n#) c + + -- There is only one physical array. + pdatas = singletondPR pdata + + -- Pre-concatenated version. + -- If the consumer pulls on this then the single segment gets physically copied. + segd = U.unsafeDemoteToSegdOfVSegd vsegd + flat = extractvs_delay pdatas vsegd + + in PNested vsegd pdatas segd flat + + + -- For segmented replicates, we just replicate the vsegids field. + -- + -- TODO: Does replicate_s really need the whole segd, + -- or could we get away without creating the indices field? + -- + -- TODO: If we know the lens does not contain zeros, then we don't need + -- to cull down the psegs. + -- + {-# INLINE_PDATA replicatesPR #-} + replicatesPR segd (PNested uvsegd pdatas _ _) + = let vsegd' = U.updateVSegsOfVSegd (U.replicate_s segd) uvsegd + segd' = U.unsafeDemoteToSegdOfVSegd vsegd' + flat' = extractvs_delay pdatas vsegd' + in PNested vsegd' pdatas segd' flat' + + + -- Append nested arrays by appending the segment descriptors, + -- and putting all physical arrays in the result. + {-# NOINLINE appendPR #-} + appendPR (PNested uvsegd1 pdatas1 _ _) (PNested uvsegd2 pdatas2 _ _) + = let vsegd' = U.appendVSegd + uvsegd1 (lengthdPR pdatas1) + uvsegd2 (lengthdPR pdatas2) + + pdatas' = appenddPR pdatas1 pdatas2 + segd' = U.unsafeDemoteToSegdOfVSegd vsegd' + flat' = extractvs_delay pdatas' vsegd' + + in PNested vsegd' pdatas' segd' flat' + + + -- Performing segmented append requires segments from the physical arrays to + -- be interspersed, so we need to copy data from the second level of nesting. + -- + -- In the implementation we can safely flatten out replication in the vsegs + -- because the source program result would have this same physical size + -- anyway. Once this is done we use copying segmented append on the flat + -- arrays, and then reconstruct the segment descriptor. + -- + {-# NOINLINE appendsPR #-} + appendsPR rsegd segd1 xarr segd2 yarr + = let (xsegd, xs) = flattenPR xarr + (ysegd, ys) = flattenPR yarr + + xsegd' = U.lengthsToSegd + $ U.sum_s segd1 (U.lengthsSegd xsegd) + + ysegd' = U.lengthsToSegd + $ U.sum_s segd2 (U.lengthsSegd ysegd) + + segd' = U.lengthsToSegd + $ U.append_s rsegd segd1 (U.lengthsSegd xsegd) + segd2 (U.lengthsSegd ysegd) + + + -- The pdatas only contains a single flat chunk. + vsegd' = U.promoteSegdToVSegd segd' + flat' = appendsPR (U.plusSegd xsegd' ysegd') + xsegd' xs + ysegd' ys + + pdatas' = singletondPR flat' + + in PNested vsegd' pdatas' segd' flat' + + + -- Projections ------------------------------------------ + {-# INLINE_PDATA lengthPR #-} + lengthPR (PNested vsegd _ _ _) + = U.lengthOfVSegd vsegd + + + -- To index into a nested array, first determine what segment the index + -- corresponds to, and extract that as a slice from that physical array. + -- + -- IMPORTANT: + -- We need to go through the vsegd here, instead of demanding the + -- flat version, because we don't want to force creation of the + -- entire manifest array. + {-# INLINE_PDATA indexPR #-} + indexPR (PNested uvsegd pdatas _ _) ix + | (pseglen@(I# pseglen#), psegstart, psegsrcid) <- U.getSegOfVSegd uvsegd ix + = let !psrc = pdatas `indexdPR` psegsrcid + !pdata' = extractPR psrc psegstart pseglen + in PArray pseglen# pdata' + + + {-# INLINE_PDATA indexsPR #-} + indexsPR pdatas@(PNesteds arrs) srcixs + = let (srcids, ixs) = U.unzip srcixs + + -- See Note: psrcoffset + !psrcoffset = V.prescanl (+) 0 + $ V.map (lengthdPR . pnested_psegdata) arrs + + -- length, start and srcid of the segments we're returning. + -- Note that we need to offset the srcid + -- TODO: don't unbox the VSegd for every iteration. + seginfo :: U.Array (Int, Int, Int) + seginfo + = U.zipWith (\srcid ix -> + let (PNested vsegd _ _ _) = pdatas `indexdPR` srcid + (len, start, srcid') = U.getSegOfVSegd vsegd ix + in (len, start, srcid' + (psrcoffset `V.unsafeIndex` srcid))) + srcids + ixs + + (pseglens', psegstarts', psegsrcs') + = U.unzip3 seginfo + + -- TODO: check that doing lengthsToSegd won't cause overflow + segd' = U.lengthsToSegd pseglens' + vsegd' = U.promoteSSegdToVSegd + $ U.mkSSegd psegstarts' psegsrcs' segd' + + -- All flat data arrays in the sources go into the result. + pdatas' = fromVectordPR + $ V.concat $ V.toList + $ V.map (toVectordPR . pnested_psegdata) arrs + + flat' = extractvs_delay pdatas' vsegd' + + in PNested vsegd' pdatas' segd' flat' + + + {-# INLINE_PDATA indexvsPR #-} + indexvsPR pdatas vsegd srcixs + = let !vsegids = U.takeVSegidsRedundantOfVSegd vsegd + !ssegd = U.takeSSegdRedundantOfVSegd vsegd + !sources = U.sourcesOfSSegd ssegd + !starts = U.startsOfSSegd ssegd + + !srcixs' + = U.map (\(ix1, ix2) + -> let !psegid = U.index "indexvsPR/vsegids" vsegids ix1 + !source = U.index "indexvsPR/sources" sources psegid + !start = U.index "indexvsPR/starts" starts psegid + in (source, start + ix2)) + srcixs + + in indexsPR pdatas srcixs' + + + -- To extract a range of elements from a nested array, perform the extract + -- on the vsegids field. The `updateVSegsOfUVSegd` function will then filter + -- out all of the psegs that are no longer reachable from the new vsegids. + -- + -- IMPORTANT: + -- We need to go through the vsegd here, instead of demanding the + -- flat version, because we don't want to force creation of the + -- entire manifest array. + {-# INLINE_PDATA extractPR #-} + extractPR (PNested uvsegd pdatas _ _) start len + = let vsegd' = U.updateVSegsOfVSegd (\vsegids -> U.extract vsegids start len) uvsegd + segd' = U.unsafeDemoteToSegdOfVSegd vsegd' + flat' = extractvs_delay pdatas vsegd' + in PNested vsegd' pdatas segd' flat' + + + -- [Note: psrcoffset] + -- ~~~~~~~~~~~~~~~~~~ + -- As all the flat data arrays in the sources are present in the result array, + -- we need to offset the psegsrcs field when combining multiple sources. + -- + -- Exaple + -- Source Arrays: + -- arr0 ... + -- psrcids : [0, 0, 0, 1, 1] + -- psegdata : [PInt xs1, PInt xs2] + -- + -- arr1 ... + -- psrcids : [0, 0, 1, 1, 2, 2, 2] + -- psegdata : [PInt ys1, PInt ys2, PInt ys3] + -- + -- Result Array: + -- psrcids : [...] + -- psegdata : [PInt xs1, PInt xs2, PInt ys1, PInt ys2, PInt ys3] + -- + -- Note that references to flatdata arrays [0, 1, 2] in arr1 need to be offset + -- by 2 (which is length arr0.psegdata) to refer to the same flat data arrays + -- in the result. + -- + -- We encode these offsets in the psrcoffset vector: + -- psrcoffset : [0, 2] + -- + -- TODO: cleanup pnested projections + -- use getSegOfUVSegd like in indexlPR + -- + {-# NOINLINE extractssPR #-} + extractssPR (PNesteds arrs) ussegd + = let + + segsrcs = U.sourcesOfSSegd ussegd + seglens = U.lengthsOfSSegd ussegd + + vsegidss = V.map (U.takeVSegidsOfVSegd . pnested_uvsegd) arrs + vsegids_src = U.extracts_nss ussegd vsegidss + srcids' = U.replicate_s (U.lengthsToSegd seglens) segsrcs + + -- See Note: psrcoffset + psrcoffset = V.prescanl (+) 0 + $ V.map (lengthdPR . pnested_psegdata) arrs + + -- Unpack the lens and srcids arrays so we don't need to + -- go though all the segment descriptors each time. + !arrs_pseglens = V.map (U.lengthsOfSSegd . U.takeSSegdOfVSegd . pnested_uvsegd) arrs + !arrs_psegstarts = V.map (U.startsOfSSegd . U.takeSSegdOfVSegd . pnested_uvsegd) arrs + !arrs_psegsrcids = V.map (U.sourcesOfSSegd . U.takeSSegdOfVSegd . pnested_uvsegd) arrs + + !here' = "extractssPR[Nested]" + -- Function to get one element of the result. + {-# INLINE get #-} + get srcid vsegid + = let !pseglen = U.index here' (arrs_pseglens `V.unsafeIndex` srcid) vsegid + !psegstart = U.index here' (arrs_psegstarts `V.unsafeIndex` srcid) vsegid + !psegsrcid = (U.index here' (arrs_psegsrcids `V.unsafeIndex` srcid) vsegid) + + (psrcoffset `V.unsafeIndex` srcid) + in (pseglen, psegstart, psegsrcid) + + (pseglens', psegstarts', psegsrcs') + = U.unzip3 $ U.zipWith get srcids' vsegids_src + + -- All flat data arrays in the sources go into the result. + pdatas' = fromVectordPR + $ V.concat $ V.toList + $ V.map (toVectordPR . pnested_psegdata) arrs + + -- Build the result segment descriptor. + segd' = U.lengthsToSegd pseglens' + vsegd' = U.promoteSSegdToVSegd + $ U.mkSSegd psegstarts' psegsrcs' segd' + + flat' = extractvs_delay pdatas' vsegd' + + in PNested vsegd' pdatas' segd' flat' + + + {-# INLINE_PDATA extractvsPR #-} + extractvsPR pdatas vsegd + = extractssPR pdatas (U.unsafeDemoteToSSegdOfVSegd vsegd) + + + -- Pack and Combine ------------------------------------- + -- Pack the vsegids to determine which of the vsegs are present in the result. + -- eg tags: [0 1 1 1 0 0 0 0 1 0 0 0 0 1 0 1 0 1 1] tag = 1 + -- vsegids: [0 0 1 1 2 2 2 2 3 3 4 4 4 5 5 5 5 6 6] + -- => vsegids_packed: [ 0 1 1 3 5 5 6 6] + -- + {-# INLINE_PDATA packByTagPR #-} + packByTagPR (PNested vsegd pdatas _ _) tags tag + = let vsegd' = U.updateVSegsOfVSegd (\vsegids -> U.packByTag vsegids tags tag) vsegd + segd' = U.unsafeDemoteToSegdOfVSegd vsegd' + flat' = extractvs_delay pdatas vsegd' + in PNested vsegd' pdatas segd' flat' + + + -- Combine nested arrays by combining the segment descriptors, + -- and putting all physical arrays in the result. + {-# INLINE_PDATA combine2PR #-} + combine2PR sel2 (PNested vsegd1 pdatas1 _ _) (PNested vsegd2 pdatas2 _ _) + = let vsegd' = U.combine2VSegd sel2 + vsegd1 (lengthdPR pdatas1) + vsegd2 (lengthdPR pdatas2) + + pdatas' = appenddPR pdatas1 pdatas2 + segd' = U.unsafeDemoteToSegdOfVSegd vsegd' + flat' = extractvs_delay pdatas' vsegd' + in PNested vsegd' pdatas' segd' flat' + + + -- Conversions ---------------------- + {-# NOINLINE fromVectorPR #-} + fromVectorPR xx + | V.length xx == 0 = emptyPR + | otherwise + = let segd = U.lengthsToSegd $ U.fromList $ V.toList $ V.map PA.length xx + vsegd = U.promoteSegdToVSegd segd + pdata = V.foldl1 appendPR $ V.map takeData xx + pdatas = singletondPR pdata + flat = extractvs_delay pdatas vsegd + in PNested vsegd pdatas segd flat + + + {-# NOINLINE toVectorPR #-} + toVectorPR arr@(PNested vsegd _ _ _) + = let len = U.length $ U.takeVSegidsOfVSegd vsegd + in V.generate len (indexPR arr) + + + -- PData -------------------------------------- + {-# INLINE_PDATA emptydPR #-} + emptydPR + = PNesteds $ V.empty + + {-# INLINE_PDATA singletondPR #-} + singletondPR pdata + = PNesteds $ V.singleton pdata + + {-# INLINE_PDATA lengthdPR #-} + lengthdPR (PNesteds vec) + = V.length vec + + {-# INLINE_PDATA indexdPR #-} + indexdPR (PNesteds vec) ix + = vec `V.unsafeIndex` ix + + {-# INLINE_PDATA appenddPR #-} + appenddPR (PNesteds xs) (PNesteds ys) + = PNesteds $ xs V.++ ys + + {-# INLINE_PDATA fromVectordPR #-} + fromVectordPR vec + = PNesteds vec + + {-# INLINE_PDATA toVectordPR #-} + toVectordPR (PNesteds vec) + = vec + + +------------------------------------------------------------------------------- +-- | Wrapper for extracts that is NOT INLINED. +-- +-- This is experimental, used to initialise the pnested_flat field +-- of a nested array. It's' marked at NOINLINE to avoid code explosion. +--- +-- TODO: at a later fusion stage we could rewrite this to an INLINED +-- version to generate core for the occurrences we actually use. +extractvs_delay :: PR a => PDatas a -> U.VSegd -> PData a +extractvs_delay pdatas vsegd + = extractvsPR pdatas vsegd +{-# NOINLINE extractvs_delay #-} +-- NOINLINE because we don't want a copy of the extracts loop to +-- be generated at the use site. + + +------------------------------------------------------------------------------ +-- | O(len result). Lifted indexing +indexlPR :: PR a => PData (PArray a) -> PData Int -> PData a +indexlPR (PNested vsegd pdatas _ _) (PInt ixs) + = indexvsPR pdatas vsegd + (U.zip (U.enumFromTo 0 (U.length ixs - 1)) + ixs) +{-# INLINE_PDATA indexlPR #-} + + +-- concatlPR ------------------------------------------------------------------ +-- | Lifted concatenation. +-- +-- Concatenate all the arrays in a triply nested array. +-- +concatlPR :: PR a => PData (PArray (PArray a)) -> PData (PArray a) +concatlPR arr + = let (segd1, darr1) = flattenPR arr + (segd2, darr2) = flattenPR darr1 + + -- Generate indices for the result array + -- See Note: Empty Arrays on End. + ixs1 = U.indicesSegd segd1 + ixs2 = U.indicesSegd segd2 + len2 = U.length ixs2 + + ixs' = U.map (\ix -> if ix >= len2 + then 0 + else U.index "concatlPR" ixs2 ix) + $ ixs1 + + segd' = U.mkSegd (U.sum_s segd1 (U.lengthsSegd segd2)) + ixs' + (U.elementsSegd segd2) + + vsegd' = U.promoteSegdToVSegd segd' + pdatas' = singletondPR flat' + flat' = darr2 + + in PNested vsegd' pdatas' segd' flat' +{-# INLINE_PDATA concatlPR #-} + +-- [Note: Empty Arrays on End] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- There is a tedious edge case when the last segment in the nested +-- array has length 0. For example: +-- +-- concatl [ [[1, 2, 3] [4, 5, 6]] [] ] +-- +-- After the calls to flattenPR we get: +-- segd1: lengths1 = [ 2 0 ] +-- indices1 = [ 0 2 ] + +-- segd2: lengths2 = [ 3 3 ] +-- indices2 = [ 0 3 ] +-- +-- The problem is that the last element of 'indices1' points off the end +-- of 'indices2' so we can't use use 'backpermute' as we'd like to: +-- ixs' = (U.bpermute (U.indicesSegd segd2) (U.indicesSegd segd1)) +-- Instead, we have to explicitly check for the out-of-bounds condition. +-- +-- TODO: We want a faster way of doing this, that doesn't require the +-- test for every element. + + + +-- unconcatPR ----------------------------------------------------------------- +-- | Build a nested array given a single flat data vector, +-- and a template nested array that defines the segmentation. + +-- Although the template nested array may be using vsegids to describe +-- internal sharing, the provided data array has manifest elements +-- for every segment. Because of this we need flatten out the virtual +-- segmentation of the template array. +-- +unconcatPR :: PR b => PData (PArray a) -> PData b -> PData (PArray b) +unconcatPR (PNested _ _ segd _) pdata + = {-# SCC "unconcatPD" #-} + let -- Demote the vsegd to a manifest vsegd so it contains all the segment + -- lengths individually without going through the vsegids. + -- Then Rebuild the vsegd based on the manifest vsegd. + -- The vsegids will be just [0..len-1], but this field is constructed + -- lazilly and consumers aren't required to demand it. + vsegd' = U.promoteSegdToVSegd segd + pdatas' = singletondPR pdata + in PNested vsegd' pdatas' segd pdata +{-# INLINE_PDATA unconcatPR #-} + + +-- appendlPR ------------------------------------------------------------------ +-- | Lifted append. +-- Both arrays must contain the same number of elements. +appendlPR :: PR a => PData (PArray a) -> PData (PArray a) -> PData (PArray a) +appendlPR arr1 arr2 + = let (segd1, darr1) = flattenPR arr1 + (segd2, darr2) = flattenPR arr2 + segd' = U.plusSegd segd1 segd2 + vsegd' = U.promoteSegdToVSegd segd' + + flat' = appendsPR segd' segd1 darr1 segd2 darr2 + pdatas' = singletondPR flat' + in PNested vsegd' pdatas' segd' flat' +{-# INLINE_PDATA appendlPR #-} + + +-- slicelPR ------------------------------------------------------------------- +-- | Extract some slices from some arrays. +-- +-- All three parameters must have the same length, and we take +-- one slice from each of the source arrays. + +-- TODO: cleanup pnested projections +slicelPR + :: PR a + => PData Int -- ^ Starting indices of slices. + -> PData Int -- ^ Lengths of slices. + -> PData (PArray a) -- ^ Arrays to slice. + -> PData (PArray a) + +slicelPR (PInt sliceStarts) (PInt sliceLens) + (PNested vsegd pdatas _segd _flat) + = let -- Build the new Segd + segd' = U.lengthsToSegd sliceLens + + -- Build the new SSegd + vsegids = U.takeVSegidsOfVSegd vsegd + ssegd = U.takeSSegdOfVSegd vsegd + psegstarts = U.startsOfSSegd ssegd + psegsrcs = U.sourcesOfSSegd ssegd + + psegstarts' = U.zipWith (+) (U.bpermute psegstarts vsegids) sliceStarts + psegsources' = U.bpermute psegsrcs vsegids + ssegd' = U.mkSSegd psegstarts' psegsources' segd' + + -- Promote SSegd to a VSegd + vsegd' = U.promoteSSegdToVSegd ssegd' + flat' = extractvs_delay pdatas vsegd' + + in PNested vsegd' pdatas segd' flat' +{-# NOINLINE slicelPR #-} +-- NOINLINE because it won't fuse with anything. +-- The operation is also entierly on the segment descriptor, so we don't +-- need to inline it to specialise it for the element type. + + +-- Testing -------------------------------------------------------------------- +-- TODO: slurp debug flag from base +validBool :: String -> Bool -> Bool +validBool str b + = if b then True + else error $ "validBool check failed -- " ++ str + + +-- Pretty --------------------------------------------------------------------- +deriving instance (Show (PDatas a), Show (PData a)) => Show (PDatas (PArray a)) +deriving instance (Show (PDatas a), Show (PData a)) => Show (PData (PArray a)) + + diff --git a/Data/Array/Parallel/PArray/PData/Sum2.hs b/Data/Array/Parallel/PArray/PData/Sum2.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PData/Sum2.hs @@ -0,0 +1,516 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | PR instance for Sum2. +module Data.Array.Parallel.PArray.PData.Sum2 + ( PData(..) + , PDatas(..) + , Sels2, lengthSels2) +where +import Data.Array.Parallel.PArray.PData.Int () +import Data.Array.Parallel.PArray.PData.Base +import Data.Array.Parallel.PArray.PData.Nested +import Data.Array.Parallel.PArray.Types +import Data.Array.Parallel.Base (intToTag) +import Data.Array.Parallel.Unlifted as U +import qualified Data.Vector as V +import Text.PrettyPrint +import Prelude as P +import Data.Array.Parallel.Pretty + +------------------------------------------------------------------------------- +data instance PData (Sum2 a b) + = PSum2 U.Sel2 + (PData a) + (PData b) + + +data instance PDatas (Sum2 a b) + = PSum2s Sels2 + (PDatas a) + (PDatas b) + +type Sels2 + = V.Vector U.Sel2 + +lengthSels2 :: Sels2 -> Int +lengthSels2 sels2 + = V.length sels2 + +-- PR ------------------------------------------------------------------------- +instance (PR a, PR b) => PR (Sum2 a b) where + + {-# NOINLINE validPR #-} + validPR _ + = True + + {-# NOINLINE similarPR #-} + similarPR x y + = case (x, y) of + (Alt2_1 x', Alt2_1 y') -> similarPR x' y' + (Alt2_2 x', Alt2_2 y') -> similarPR x' y' + _ -> False + + {-# NOINLINE nfPR #-} + nfPR (PSum2 sel xs ys) + = sel `seq` nfPR xs `seq` nfPR ys `seq` () + + {-# NOINLINE coversPR #-} + coversPR weak (PSum2 sel _ _) ix + | weak = ix <= U.length (U.tagsSel2 sel) + | otherwise = ix < U.length (U.tagsSel2 sel) + + + {-# NOINLINE pprpPR #-} + pprpPR xx + = case xx of + Alt2_1 x -> text "Alt2_1" <+> parens (pprpPR x) + Alt2_2 y -> text "Alt2_2" <+> parens (pprpPR y) + + + {-# NOINLINE pprpDataPR #-} + pprpDataPR (PSum2 sel pdatas1 pdatas2) + = text "PSum2" + $+$ (nest 4 $ vcat + [ pprp sel + , text "ALTS0: " <+> pprp pdatas1 + , text "ALTS1: " <+> pprp pdatas2]) + + + -- Constructors ------------------------------- + {-# INLINE_PDATA emptyPR #-} + emptyPR + = PSum2 (U.mkSel2 U.empty U.empty 0 0 (U.mkSelRep2 U.empty)) emptyPR emptyPR + + + {-# INLINE_PDATA replicatePR #-} + replicatePR n aa + = case aa of + Alt2_1 x + -> PSum2 (U.mkSel2 (U.replicate n 0) + (U.enumFromStepLen 0 1 n) + n 0 + (U.mkSelRep2 (U.replicate n 0))) + (replicatePR n x) + emptyPR + + Alt2_2 x + -> PSum2 (U.mkSel2 (U.replicate n 1) + (U.enumFromStepLen 0 1 n) + 0 n + (U.mkSelRep2 (U.replicate n 1))) + emptyPR + (replicatePR n x) + + + {-# INLINE_PDATA replicatesPR #-} + replicatesPR segd (PSum2 sel as bs) + = let tags = U.tagsSel2 sel + tags' = U.replicate_s segd tags + sel' = U.tagsToSel2 tags' + + lens = U.lengthsSegd segd + asegd = U.lengthsToSegd (U.packByTag lens tags 0) + bsegd = U.lengthsToSegd (U.packByTag lens tags 1) + + as' = replicatesPR asegd as + bs' = replicatesPR bsegd bs + in PSum2 sel' as' bs' + + + {-# INLINE_PDATA appendPR #-} + appendPR (PSum2 sel1 as1 bs1) + (PSum2 sel2 as2 bs2) + = let !sel = U.tagsToSel2 $ U.tagsSel2 sel1 U.+:+ U.tagsSel2 sel2 + as = appendPR as1 as2 + bs = appendPR bs1 bs2 + in PSum2 sel as bs + + + -- Projections -------------------------------- + {-# INLINE_PDATA lengthPR #-} + lengthPR (PSum2 sel _ _) + = U.length $ tagsSel2 sel + + + {-# INLINE_PDATA indexPR #-} + indexPR (PSum2 sel as bs) i + = let !k = U.index "indexPR[Sum2]" (U.indicesSel2 sel) i + in case U.index "indexPR[Sum2]" (U.tagsSel2 sel) i of + 0 -> Alt2_1 (indexPR as k) + _ -> Alt2_2 (indexPR bs k) + + {-# INLINE_PDATA indexsPR #-} + indexsPR (PSum2s sels ass bss) srcixs + = let (srcids, ixs) = U.unzip srcixs + + getFlagIndex !src !ix + = let !sel = V.unsafeIndex sels src + !elemFlag = U.index "indexPR[Sum2]" (U.tagsSel2 sel) ix + !elemIndex = U.index "indexPR[Sum2]" (U.indicesSel2 sel) ix + in (elemFlag, elemIndex) + + (flags', indices') + = U.unzip $ U.zipWith getFlagIndex srcids ixs + + sel' = U.tagsToSel2 flags' + asIndices = U.packByTag indices' flags' 0 + bsIndices = U.packByTag indices' flags' 1 + + as' = indexsPR ass (U.zip srcids asIndices) + bs' = indexsPR bss (U.zip srcids bsIndices) + + in PSum2 sel' as' bs' + + + -- extract / extracts + -- Extract a range of elements from an array of Sum2s. + -- Example: + -- arr: [L 20, R 30, L 40, R 50, R 60, R 70, L 80, R 90, L 100] + -- ----------------------------- + -- Sel2: + -- TAGS: [0 1 0 1 1 1 0 1 0] + -- INDICES: [0 0 1 1 2 3 2 4 3] + -- ALTS0: PInt [20 40 80 100] + -- ALTS1: PInt [30 50 60 70 90] + -- + -- Goal: extract arr 2 5 + -- = [L 40, R 50, R 60, R 70, L 80] + -- Sel2: + -- TAGS: [0 1 1 1 0] + -- INDICES: [0 0 1 2 1] + -- ALTS0: PInt [40 80] + -- ALTS1: PInt [50 60 70] + -- + {-# NOINLINE extractPR #-} + extractPR (PSum2 sel as bs) start len + = let + -- Extract the tags of the result elements, + -- and rebuild the result selector indices based on these tags. + -- This is the selelector for the result array. + -- TAGS: [0 1 1 1 0] + -- INDICES: [0 0 1 2 1] + tags' = U.extract (U.tagsSel2 sel) start len + sel' = U.tagsToSel2 tags' + + -- Extract the indices of the data elements that we want. + -- These are the indices of the elements in their source arrays. + -- INDICES: [1 1 2 3 2] + indices' = U.extract (U.indicesSel2 sel) start len + + -- Build maps of which source index to get the data for each ALT array. + -- indices0: [1 2] + -- indices1: [1 2 3] + indices0 = U.packByTag indices' tags' 0 + indices1 = U.packByTag indices' tags' 1 + + -- Copy source data into new ALT arrays. + -- as: [40 80] + -- bs: [50 60 70] + as' = bpermutePR as indices0 + bs' = bpermutePR bs indices1 + + in PSum2 sel' as' bs' + + + -- Extract several ranges of elements form some arrays of Sum2s. + -- Example: + -- arrs: 0: [L 20, R 30, L 40] + -- ----------1 ----3 + -- 1: [R 50, R 60, R 70, L 80, R 90, L 100] + -- ----4 ----------------0 -----------2 + -- + -- Sel2 + -- 0 TAGS: [0 1 0] + -- INDICES: [0 0 1] + -- -------1 ----3 + -- ALTS0: [20 40] + -- ALTS1: [30] + -- + -- 1 TAGS: [1 1 1 0 1 0] + -- INDICES: [0 1 2 0 3 1] + -- ----4 --------------0 --------2 + -- ALTS0 [80 100] + -- ALTS1 [50 60 70 90] + -- + -- Goal: extract arrs ssegd + -- => [R 60, R 70, L 80, L 20, R 30, R 90, L 100, L 40, R 50] + -- ----------------0 ----------1 -----------2 ----3 ----4 + -- + -- Sel2: + -- TAGS: [1 1 0 0 1 1 0 0 1] + -- INDICES: [0 1 0 1 2 3 2 3 4] + -- ALTS0: [80 20 100 40] + -- ALTS1: [60 70 30 90 50] + -- + -- ssegd: + -- SRCIDS: [1 0 1 0 1] + -- STARTS: [1 0 4 2 0] + -- LENGTHS: [3 2 2 1 1] + -- + {-# NOINLINE extractssPR #-} + extractssPR (PSum2s sels pdatas0 pdatas1) ssegd + = let + tagss = V.map U.tagsSel2 sels + + -- Extract the tags of the result elements, + -- and rebuild the result selector indices based on these tags. + -- tags' = [1 1 0 0 1 1 0 0 1] + -- sel' = [0 1 0 1 2 3 2 3 4] + tags' = U.extracts_nss ssegd tagss + sel' = U.tagsToSel2 tags' + + -- Extract the indices of the data elements we want. + -- These are the indices of the elements in their source arrays. + -- (result) [R 60, R 70, L 80, L 20, R 30, R 90, L 100, L 40, R 50] + -- ----------------0 ----------1 -----------2 ----3 ----4 + -- indices' = [ 1 2 0 0 0 3 1 1 0 ] + indices' = U.extracts_nss ssegd (V.map U.indicesSel2 sels) + + -- Count the number of L and R elements for each segment, + -- then scan them to produce the starting index of each segment in the + -- result alt data. + + -- ALTS0: [80 20 100 40 ] (result) + -- --0 --1 --2 --3 .4 (segs) + -- lens0 = [1 1 1 1 0 ] + -- indices0 = [0 1 2 3 4 ] + + -- ALTS1: [60 70 30 90 50] (result) + -- ------0 --1 --2 .3 --4 (segs) + -- lens1 = [2 1 1 0 1 ] + -- indices1 = [0 2 3 3 4 ] + + lens0 = U.count_ss ssegd tagss 0 + indices0 = U.scan (+) 0 lens0 + + lens1 = U.count_ss ssegd tagss 1 + indices1 = U.scan (+) 0 lens1 + + -- For each segment in the result alt data, get its starting index in + -- the original alt array. + -- + -- TODO: We're doing this by getting the index of EVERY result eleement + -- as it is in the original array original array, then just selecting + -- the indices corresponding to the start of each segment. If the last + -- segment has length 0, then we get an index overflow problem because + -- the last element in the indices array doesn't point to real data. + -- There might be a better way to do this that doesn't require copying + -- all indices, and doesn't need a bounds check. + -- + + -- indices0 = [ 0 1 2 3 4 ] (from above) + -- sel0 = [ 0 0 1 1 ] -- here, we've only got starting indices + -- sel0_len = 4 -- for 4 segs, but there are 5 segs in total. + -- starts0 = [ 0 0 1 1 0 ] + sel0 = U.packByTag indices' tags' 0 + sel0_len = U.length sel0 + starts0 = U.map (\i -> if i >= sel0_len + then 0 + else U.index "extractssPR[Sum2]" sel0 i) + indices0 + + -- indices1 = [ 0 2 3 3 4 ] (from above) + -- sel1 = [ 1 2 0 3 0 ] + -- sel1_len = 5 + -- starts1 = [ 1 0 3 3 0 ] + sel1 = U.packByTag indices' tags' 1 + sel1_len = U.length sel1 + starts1 = U.map (\i -> if i >= sel1_len + then 0 + else U.index "extractssPR[Sum2]" sel1 i) + indices1 + + -- Extract the final alts data: + -- sources = [ 1 0 1 0 1 ] (from above) + -- starts0 = [ 0 0 1 1 0 ] (from above) + -- starts1 = [ 1 0 3 3 0 ] (from above) + -- lens0 = [ 1 1 1 1 0 ] (from above) + -- lens1 = [ 2 1 1 0 1 ] (from above) + + -- (source data) + -- 0: ALTS0: [20 40] + -- --1 --3 + -- ALTS1: [30] + -- --1 .3 (no alt1 data for seg 3) + -- + -- 1: ALTS0: [80 100] + -- --0 ---2 .4 (no alt0 data for seg 4) + -- ALTS1: [50 60 70 90] + -- --4 -----0 --2 + + -- (result data) + -- ALTS0: [80 20 100 40 ] + -- ALTS1: [60 70 30 90 50] + + pdata0 = extractssPR pdatas0 + $ U.mkSSegd starts0 + (U.sourcesOfSSegd ssegd) + (U.lengthsToSegd lens0) + + pdata1 = extractssPR pdatas1 + $ U.mkSSegd starts1 + (U.sourcesOfSSegd ssegd) + (U.lengthsToSegd lens1) + + in {- trace (render $ vcat + [ text "tags' = " <> pprp tags' + , text "" + , text "lens0 = " <> pprp lens0 + , text "selStarts0 = " <> pprp selStarts0 + , text "sel0 = " <> pprp sel0 + , text "starts0 = " <> pprp starts0 + , text "" + , text "lens1 = " <> pprp lens1 + , text "selStarts1 = " <> pprp selStarts1 + , text "sel1 = " <> pprp sel1 + , text "" + , text "sources = " <> pprp sources + , text "selindices' = " <> pprp selIndices' + , text ""]) $ -} + PSum2 sel' pdata0 pdata1 + + {-# INLINE_PDATA extractvsPR #-} + extractvsPR pdatas vsegd + = extractssPR pdatas (unsafeDemoteToSSegdOfVSegd vsegd) + + + -- Pack and Combine --------------------------- + + -- Select the elements of an array that match the given tag. + -- Example: + -- arr = [L 20, R 30, L 40, L 50, R 60, L 70, R 80, L 90] + -- flags = [0 1 0 0 1 0 1 0] + -- indices = [0 0 1 2 1 3 2 4] + -- as = [20 40 50 70 90] + -- bs = [30 60 80] + -- + -- tags = [1 1 0 1 0 0 1 0] + -- result = [L 20, R 30, L 50, R 80] + -- flags' = [0 1 0 1] + -- as' = [20 50] + -- as' = [30 80] + -- + {-# NOINLINE packByTagPR #-} + packByTagPR (PSum2 sel as bs) tags tag + = let flags = U.tagsSel2 sel + + -- Make the flags of the result + -- flags' = [0 1 0 1] + flags' = U.packByTag flags tags (intToTag tag) + sel' = U.tagsToSel2 flags' + + -- Map the tags array onto the data for each alternative. + -- This tells us what of the alt data we want to keep. + -- atags = [ 1 0 1 0 0 ] + -- btags = [ 1 0 1 ] + atags = U.packByTag tags flags 0 + btags = U.packByTag tags flags 1 + + -- Now pack the alt data using the above tag arrays + -- as' = [ 20 50 ] + -- bs' = [ 30 80 ] + as' = packByTagPR as atags tag + bs' = packByTagPR bs btags tag + in PSum2 sel' as' bs' + + + {-# NOINLINE combine2PR #-} + combine2PR sel (PSum2 sel1 as1 bs1) (PSum2 sel2 as2 bs2) + = let tags = U.tagsSel2 sel + tags' = U.combine2 (U.tagsSel2 sel) (U.repSel2 sel) + (U.tagsSel2 sel1) (U.tagsSel2 sel2) + sel' = U.tagsToSel2 tags' + + asel = U.tagsToSel2 (U.packByTag tags tags' 0) + bsel = U.tagsToSel2 (U.packByTag tags tags' 1) + + as = combine2PR asel as1 as2 + bs = combine2PR bsel bs1 bs2 + in PSum2 sel' as bs + + + -- Conversions -------------------------------- + -- TODO: fix rubbish via-lists filtering. + {-# NOINLINE fromVectorPR #-} + fromVectorPR vec + = let tags = V.convert $ V.map tagOfSum2 vec + sel2 = U.tagsToSel2 tags + as' = fromVectorPR $ V.fromList $ [x | Alt2_1 x <- V.toList vec] + bs' = fromVectorPR $ V.fromList $ [x | Alt2_2 x <- V.toList vec] + + in PSum2 sel2 as' bs' + + + {-# NOINLINE toVectorPR #-} + toVectorPR pdata@(PSum2 sel _ _) + = let len = U.length $ U.tagsSel2 sel + in if len == 0 + then V.empty + else V.map (indexPR pdata) + $ V.enumFromTo 0 (len - 1) + + + -- PDatas ------------------------------------- + {-# INLINE_PDATA emptydPR #-} + emptydPR + = PSum2s V.empty emptydPR emptydPR + + + {-# INLINE_PDATA singletondPR #-} + singletondPR (PSum2 sel2 xs ys) + = PSum2s (V.singleton sel2) + (singletondPR xs) + (singletondPR ys) + + + {-# INLINE_PDATA lengthdPR #-} + lengthdPR (PSum2s sel2s _ _) + = V.length sel2s + + + {-# INLINE_PDATA indexdPR #-} + indexdPR (PSum2s sel2s xss yss) ix + = PSum2 (sel2s `V.unsafeIndex` ix) + (indexdPR xss ix) + (indexdPR yss ix) + + + {-# INLINE_PDATA appenddPR #-} + appenddPR (PSum2s sels1 xss1 yss1) + (PSum2s sels2 xss2 yss2) + = PSum2s (sels1 V.++ sels2) + (xss1 `appenddPR` xss2) + (yss1 `appenddPR` yss2) + + + -- TODO: fix rubbish via-lists conversion. + {-# NOINLINE fromVectordPR #-} + fromVectordPR vec + = let (sels, pdatas1, pdatas2) + = P.unzip3 + $ [ (sel, pdata1, pdata2) + | PSum2 sel pdata1 pdata2 <- V.toList vec] + in PSum2s (V.fromList sels) + (fromVectordPR $ V.fromList pdatas1) + (fromVectordPR $ V.fromList pdatas2) + + + {-# NOINLINE toVectordPR #-} + toVectordPR (PSum2s sels pdatas1 pdatas2) + = let vecs1 = toVectordPR pdatas1 + vecs2 = toVectordPR pdatas2 + + in V.zipWith3 PSum2 sels vecs1 vecs2 + + +-- Pretty --------------------------------------------------------------------- +instance PprPhysical U.Sel2 where + pprp sel2 + = text "Sel2" + $+$ (nest 4 $ vcat + [ text "TAGS: " <+> text (show $ U.toList $ U.tagsSel2 sel2) + , text "INDICES:" <+> text (show $ U.toList $ U.indicesSel2 sel2)]) + + diff --git a/Data/Array/Parallel/PArray/PData/Tuple2.hs b/Data/Array/Parallel/PArray/PData/Tuple2.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PData/Tuple2.hs @@ -0,0 +1,251 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | PR instance for tuples. +module Data.Array.Parallel.PArray.PData.Tuple2 + ( PData(..), PDatas(..) + , zipPD + , ziplPR + , unzipPD + , unziplPD) +where +import Data.Array.Parallel.Pretty +import Data.Array.Parallel.PArray.PData.Base +import Data.Array.Parallel.PArray.PData.Nested +import GHC.Exts +import Prelude hiding (zip, unzip) +import qualified Data.Vector as V +import qualified Prelude as P +import qualified Data.Array.Parallel.Unlifted as U + +------------------------------------------------------------------------------- +data instance PData (a, b) + = PTuple2 (PData a) (PData b) + +data instance PDatas (a, b) + = PTuple2s (PDatas a) (PDatas b) + + +-- PR ------------------------------------------------------------------------- +instance (PR a, PR b) => PR (a, b) where + + {-# NOINLINE validPR #-} + validPR (PTuple2 xs ys) + = validPR xs && validPR ys + + + {-# NOINLINE nfPR #-} + nfPR (PTuple2 arr1 arr2) + = nfPR arr1 `seq` nfPR arr2 `seq` () + + + {-# NOINLINE similarPR #-} + similarPR (x1, y1) (x2, y2) + = similarPR x1 x2 + && similarPR y1 y2 + + + {-# NOINLINE coversPR #-} + coversPR weak (PTuple2 arr1 arr2) ix + = coversPR weak arr1 ix + && coversPR weak arr2 ix + + {-# NOINLINE pprpPR #-} + pprpPR (x, y) + = text "Tuple2 " <> vcat [pprpPR x, pprpPR y] + + + {-# NOINLINE pprpDataPR #-} + pprpDataPR (PTuple2 xs ys) + = text "PTuple2 " <> vcat [pprpDataPR xs, pprpDataPR ys] + + -- Constructors ------------------------------- + {-# INLINE_PDATA emptyPR #-} + emptyPR + = PTuple2 emptyPR emptyPR + + + {-# INLINE_PDATA replicatePR #-} + replicatePR len (x, y) + = PTuple2 (replicatePR len x) + (replicatePR len y) + + + {-# INLINE_PDATA replicatesPR #-} + replicatesPR lens (PTuple2 arr1 arr2) + = PTuple2 (replicatesPR lens arr1) + (replicatesPR lens arr2) + + + {-# INLINE_PDATA appendPR #-} + appendPR (PTuple2 arr11 arr12) (PTuple2 arr21 arr22) + = PTuple2 (arr11 `appendPR` arr21) + (arr12 `appendPR` arr22) + + + {-# INLINE_PDATA appendsPR #-} + appendsPR segdResult segd1 (PTuple2 arrs11 arrs12) segd2 (PTuple2 arrs21 arrs22) + = PTuple2 (appendsPR segdResult segd1 arrs11 segd2 arrs21) + (appendsPR segdResult segd1 arrs12 segd2 arrs22) + + + -- Projections --------------------------------- + {-# INLINE_PDATA lengthPR #-} + lengthPR (PTuple2 arr1 _) + = lengthPR arr1 + + {-# INLINE_PDATA indexPR #-} + indexPR (PTuple2 arr1 arr2) ix + = (indexPR arr1 ix, indexPR arr2 ix) + + {-# INLINE_PDATA indexsPR #-} + indexsPR (PTuple2s xs ys) srcixs + = PTuple2 (indexsPR xs srcixs) + (indexsPR ys srcixs) + + {-# INLINE_PDATA indexvsPR #-} + indexvsPR (PTuple2s xs ys) vsegd srcixs + = PTuple2 (indexvsPR xs vsegd srcixs) + (indexvsPR ys vsegd srcixs) + + {-# INLINE_PDATA extractPR #-} + extractPR (PTuple2 arr1 arr2) start len + = PTuple2 (extractPR arr1 start len) + (extractPR arr2 start len) + + {-# INLINE_PDATA extractssPR #-} + extractssPR (PTuple2s xs ys) ussegd + = PTuple2 (extractssPR xs ussegd) + (extractssPR ys ussegd) + + {-# INLINE_PDATA extractvsPR #-} + extractvsPR (PTuple2s xs ys) uvsegd + = PTuple2 (extractvsPR xs uvsegd) + (extractvsPR ys uvsegd) + + + -- Pack and Combine --------------------------- + {-# INLINE_PDATA packByTagPR #-} + packByTagPR (PTuple2 arr1 arr2) tags tag + = PTuple2 (packByTagPR arr1 tags tag) + (packByTagPR arr2 tags tag) + + {-# INLINE_PDATA combine2PR #-} + combine2PR sel (PTuple2 xs1 ys1) (PTuple2 xs2 ys2) + = PTuple2 (combine2PR sel xs1 xs2) + (combine2PR sel ys1 ys2) + + + -- Conversions -------------------------------- + {-# NOINLINE fromVectorPR #-} + fromVectorPR vec + = let (xs, ys) = V.unzip vec + in PTuple2 (fromVectorPR xs) + (fromVectorPR ys) + + {-# NOINLINE toVectorPR #-} + toVectorPR (PTuple2 xs ys) + = V.zip (toVectorPR xs) + (toVectorPR ys) + + + -- PData -------------------------------------- + {-# INLINE_PDATA emptydPR #-} + emptydPR + = PTuple2s emptydPR + emptydPR + + + {-# INLINE_PDATA singletondPR #-} + singletondPR (PTuple2 x y) + = PTuple2s (singletondPR x) + (singletondPR y) + + + {-# INLINE_PDATA lengthdPR #-} + lengthdPR (PTuple2s xs _) + = lengthdPR xs + + + {-# INLINE_PDATA indexdPR #-} + indexdPR (PTuple2s xs ys) i + = PTuple2 (indexdPR xs i) + (indexdPR ys i) + + + {-# INLINE_PDATA appenddPR #-} + appenddPR (PTuple2s xs1 ys1) (PTuple2s xs2 ys2) + = PTuple2s (appenddPR xs1 xs2) + (appenddPR ys1 ys2) + + + {-# NOINLINE fromVectordPR #-} + fromVectordPR vec + = let (xss, yss) = V.unzip $ V.map (\(PTuple2 xs ys) -> (xs, ys)) vec + in PTuple2s (fromVectordPR xss) + (fromVectordPR yss) + + + {-# NOINLINE toVectordPR #-} + toVectordPR (PTuple2s pdatas1 pdatas2) + = V.zipWith PTuple2 + (toVectordPR pdatas1) + (toVectordPR pdatas2) + + +-- PD Functions --------------------------------------------------------------- +-- These work on PData arrays of tuples, but don't need a PA or PR dictionary + +-- | O(1). Zip a pair of arrays into an array of pairs. +zipPD :: PData a -> PData b -> PData (a, b) +zipPD = PTuple2 +{-# INLINE_PA zipPD #-} + + +-- | Lifted zip. +ziplPR :: (PR a, PR b) => PData (PArray a) -> PData (PArray b) -> PData (PArray (a, b)) +ziplPR arr1 arr2 + = let -- We need to flatten the data here because we can't guarantee + -- that the vsegds of both arrays have the same form. + -- One of the arrays may have been created with replicate, and + -- thus has internal sharing, while the other does not. + (segd1, pdata1) = flattenPR arr1 + (_, pdata2) = flattenPR arr2 + vsegd' = U.promoteSegdToVSegd segd1 + + in PNested vsegd' + (PTuple2s (singletondPR pdata1) (singletondPR pdata2)) + segd1 + (PTuple2 pdata1 pdata2) + +{-# INLINE_PA ziplPR #-} + + +-- | O(1). Unzip an array of pairs into a pair of arrays. +unzipPD :: PData (a, b) -> (PData a, PData b) +unzipPD (PTuple2 xs ys) = (xs, ys) +{-# INLINE_PA unzipPD #-} + + +-- | Lifted unzip. +unziplPD :: PData (PArray (a, b)) -> PData (PArray a, PArray b) +unziplPD (PNested vsegd (PTuple2s xsdata ysdata) segd (PTuple2 xflat yflat)) + = PTuple2 (PNested vsegd xsdata segd xflat) + (PNested vsegd ysdata segd yflat) +{-# INLINE_PA unziplPD #-} + + +-- Show ----------------------------------------------------------------------- +deriving instance (Show (PData a), Show (PData b)) => Show (PData (a, b)) +deriving instance (Show (PDatas a), Show (PDatas b)) => Show (PDatas (a, b)) + + +instance ( PR a, PR b, Show a, Show b + , PprVirtual (PData a), PprVirtual (PData b)) + => PprVirtual (PData (a, b)) where + pprv (PTuple2 xs ys) + = text $ show + $ P.zip (V.toList $ toVectorPR xs) + (V.toList $ toVectorPR ys) + diff --git a/Data/Array/Parallel/PArray/PData/Tuple3.hs b/Data/Array/Parallel/PArray/PData/Tuple3.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PData/Tuple3.hs @@ -0,0 +1,242 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | PR instance for tuples. +module Data.Array.Parallel.PArray.PData.Tuple3 + ( PData(..), PDatas(..) + , zip3PD) +where +import Data.Array.Parallel.Pretty +import Data.Array.Parallel.PArray.PData.Base +import Data.Array.Parallel.PArray.PData.Nested +import GHC.Exts +import Prelude hiding (zip, unzip) +import qualified Data.Vector as V +import qualified Prelude as P + +------------------------------------------------------------------------------- +data instance PData (a, b, c) + = PTuple3 (PData a) (PData b) (PData c) + +data instance PDatas (a, b, c) + = PTuple3s (PDatas a) (PDatas b) (PDatas c) + + +-- PR ------------------------------------------------------------------------- +instance (PR a, PR b, PR c) => PR (a, b, c) where + + {-# NOINLINE validPR #-} + validPR (PTuple3 xs ys zs) + = validPR xs && validPR ys && validPR zs + + + {-# NOINLINE nfPR #-} + nfPR (PTuple3 arr1 arr2 arr3) + = nfPR arr1 `seq` nfPR arr2 `seq` nfPR arr3 `seq` () + + + {-# NOINLINE similarPR #-} + similarPR (x1, y1, z1) (x2, y2, z2) + = similarPR x1 x2 + && similarPR y1 y2 + && similarPR z1 z2 + + + {-# NOINLINE coversPR #-} + coversPR weak (PTuple3 arr1 arr2 arr3) ix + = coversPR weak arr1 ix + && coversPR weak arr2 ix + && coversPR weak arr3 ix + + {-# NOINLINE pprpPR #-} + pprpPR (x, y, z) + = text "Tuple3 " + <> vcat [ pprpPR x + , pprpPR y + , pprpPR z] + + + {-# NOINLINE pprpDataPR #-} + pprpDataPR (PTuple3 xs ys zs) + = text "PTuple3 " + <> vcat [ pprpDataPR xs + , pprpDataPR ys + , pprpDataPR zs] + + + -- Constructors ------------------------------- + {-# INLINE_PDATA emptyPR #-} + emptyPR + = PTuple3 emptyPR emptyPR emptyPR + + + {-# INLINE_PDATA replicatePR #-} + replicatePR len (x, y, z) + = PTuple3 (replicatePR len x) + (replicatePR len y) + (replicatePR len z) + + + {-# INLINE_PDATA replicatesPR #-} + replicatesPR lens (PTuple3 arr1 arr2 arr3) + = PTuple3 (replicatesPR lens arr1) + (replicatesPR lens arr2) + (replicatesPR lens arr3) + + + {-# INLINE_PDATA appendPR #-} + appendPR (PTuple3 arr11 arr12 arr13) (PTuple3 arr21 arr22 arr23) + = PTuple3 (arr11 `appendPR` arr21) + (arr12 `appendPR` arr22) + (arr13 `appendPR` arr23) + + + {-# INLINE_PDATA appendsPR #-} + appendsPR segdResult segd1 (PTuple3 arrs11 arrs12 arrs13) segd2 (PTuple3 arrs21 arrs22 arrs23) + = PTuple3 (appendsPR segdResult segd1 arrs11 segd2 arrs21) + (appendsPR segdResult segd1 arrs12 segd2 arrs22) + (appendsPR segdResult segd1 arrs13 segd2 arrs23) + + + -- Projections --------------------------------- + {-# INLINE_PDATA lengthPR #-} + lengthPR (PTuple3 arr1 _ _) + = lengthPR arr1 + + {-# INLINE_PDATA indexPR #-} + indexPR (PTuple3 arr1 arr2 arr3) ix + = (indexPR arr1 ix, indexPR arr2 ix, indexPR arr3 ix) + + {-# INLINE_PDATA indexsPR #-} + indexsPR (PTuple3s xs ys zs) srcixs + = PTuple3 (indexsPR xs srcixs) + (indexsPR ys srcixs) + (indexsPR zs srcixs) + + {-# INLINE_PDATA indexvsPR #-} + indexvsPR (PTuple3s xs ys zs) vsegd srcixs + = PTuple3 (indexvsPR xs vsegd srcixs) + (indexvsPR ys vsegd srcixs) + (indexvsPR zs vsegd srcixs) + + {-# INLINE_PDATA extractPR #-} + extractPR (PTuple3 arr1 arr2 arr3) start len + = PTuple3 (extractPR arr1 start len) + (extractPR arr2 start len) + (extractPR arr3 start len) + + {-# INLINE_PDATA extractssPR #-} + extractssPR (PTuple3s xs ys zs) ussegd + = PTuple3 (extractssPR xs ussegd) + (extractssPR ys ussegd) + (extractssPR zs ussegd) + + {-# INLINE_PDATA extractvsPR #-} + extractvsPR (PTuple3s xs ys zs) uvsegd + = PTuple3 (extractvsPR xs uvsegd) + (extractvsPR ys uvsegd) + (extractvsPR zs uvsegd) + + + -- Pack and Combine --------------------------- + {-# INLINE_PDATA packByTagPR #-} + packByTagPR (PTuple3 arr1 arr2 arr3) tags tag + = PTuple3 (packByTagPR arr1 tags tag) + (packByTagPR arr2 tags tag) + (packByTagPR arr3 tags tag) + + {-# INLINE_PDATA combine2PR #-} + combine2PR sel (PTuple3 xs1 ys1 zs1) (PTuple3 xs2 ys2 zs2) + = PTuple3 (combine2PR sel xs1 xs2) + (combine2PR sel ys1 ys2) + (combine2PR sel zs1 zs2) + + + -- Conversions -------------------------------- + {-# NOINLINE fromVectorPR #-} + fromVectorPR vec + = let (xs, ys, zs) = V.unzip3 vec + in PTuple3 (fromVectorPR xs) + (fromVectorPR ys) + (fromVectorPR zs) + + {-# NOINLINE toVectorPR #-} + toVectorPR (PTuple3 xs ys zs) + = V.zip3 (toVectorPR xs) + (toVectorPR ys) + (toVectorPR zs) + + + -- PData -------------------------------------- + {-# INLINE_PDATA emptydPR #-} + emptydPR + = PTuple3s emptydPR + emptydPR + emptydPR + + + {-# INLINE_PDATA singletondPR #-} + singletondPR (PTuple3 x y z) + = PTuple3s (singletondPR x) + (singletondPR y) + (singletondPR z) + + + {-# INLINE_PDATA lengthdPR #-} + lengthdPR (PTuple3s xs _ _) + = lengthdPR xs + + + {-# INLINE_PDATA indexdPR #-} + indexdPR (PTuple3s xs ys zs) i + = PTuple3 (indexdPR xs i) + (indexdPR ys i) + (indexdPR zs i) + + + {-# INLINE_PDATA appenddPR #-} + appenddPR (PTuple3s xs1 ys1 zs1) (PTuple3s xs2 ys2 zs2) + = PTuple3s (appenddPR xs1 xs2) + (appenddPR ys1 ys2) + (appenddPR zs1 zs2) + + + {-# NOINLINE fromVectordPR #-} + fromVectordPR vec + = let (xss, yss, zss) = V.unzip3 $ V.map (\(PTuple3 xs ys zs) -> (xs, ys, zs)) vec + in PTuple3s (fromVectordPR xss) + (fromVectordPR yss) + (fromVectordPR zss) + + + {-# NOINLINE toVectordPR #-} + toVectordPR (PTuple3s pdatas1 pdatas2 pdatas3) + = V.zipWith3 PTuple3 + (toVectordPR pdatas1) + (toVectordPR pdatas2) + (toVectordPR pdatas3) + +-- PD Functions --------------------------------------------------------------- +-- | O(1). Zip a pair of arrays into an array of pairs. +zip3PD :: PData a -> PData b -> PData c -> PData (a, b, c) +zip3PD = PTuple3 +{-# INLINE_PA zip3PD #-} + + +-- Show ----------------------------------------------------------------------- +deriving instance (Show (PData a), Show (PData b), Show (PData c)) + => Show (PData (a, b, c)) + +deriving instance (Show (PDatas a), Show (PDatas b), Show (PDatas c)) + => Show (PDatas (a, b, c)) + + +instance ( PR a, PR b, PR c, Show a, Show b, Show c + , PprVirtual (PData a), PprVirtual (PData b), PprVirtual (PData c)) + => PprVirtual (PData (a, b, c)) where + pprv (PTuple3 xs ys zs) + = text $ show + $ P.zip3 (V.toList $ toVectorPR xs) + (V.toList $ toVectorPR ys) + (V.toList $ toVectorPR zs) diff --git a/Data/Array/Parallel/PArray/PData/Tuple4.hs b/Data/Array/Parallel/PArray/PData/Tuple4.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PData/Tuple4.hs @@ -0,0 +1,279 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | PR instance for tuples. +module Data.Array.Parallel.PArray.PData.Tuple4 + ( PData(..), PDatas(..) + , zip4PD) +where +import Data.Array.Parallel.Pretty +import Data.Array.Parallel.PArray.PData.Base +import Data.Array.Parallel.PArray.PData.Nested +import GHC.Exts +import Prelude hiding (zip, unzip) +import qualified Data.Vector as V +import qualified Prelude as P +import qualified Data.List as P + +------------------------------------------------------------------------------- +data instance PData (a, b, c, d) + = PTuple4 (PData a) (PData b) (PData c) (PData d) + +data instance PDatas (a, b, c, d) + = PTuple4s (PDatas a) (PDatas b) (PDatas c) (PDatas d) + + +-- PR ------------------------------------------------------------------------- +instance (PR a, PR b, PR c, PR d) => PR (a, b, c, d) where + + {-# NOINLINE validPR #-} + validPR (PTuple4 xs ys zs ds) + = validPR xs && validPR ys && validPR zs && validPR ds + + + {-# NOINLINE nfPR #-} + nfPR (PTuple4 arr1 arr2 arr3 arr4) + = nfPR arr1 `seq` nfPR arr2 `seq` nfPR arr3 `seq` nfPR arr4 `seq` () + + + {-# NOINLINE similarPR #-} + similarPR (x1, y1, z1, d1) (x2, y2, z2, d2) + = similarPR x1 x2 + && similarPR y1 y2 + && similarPR z1 z2 + && similarPR d1 d2 + + + {-# NOINLINE coversPR #-} + coversPR weak (PTuple4 arr1 arr2 arr3 arr4) ix + = coversPR weak arr1 ix + && coversPR weak arr2 ix + && coversPR weak arr3 ix + && coversPR weak arr4 ix + + + {-# NOINLINE pprpPR #-} + pprpPR (x, y, z, d) + = text "Tuple4 " + <> vcat [ pprpPR x + , pprpPR y + , pprpPR z + , pprpPR d ] + + + {-# NOINLINE pprpDataPR #-} + pprpDataPR (PTuple4 xs ys zs ds) + = text "PTuple4 " + <> vcat [ pprpDataPR xs + , pprpDataPR ys + , pprpDataPR zs + , pprpDataPR ds] + + + -- Constructors ------------------------------- + {-# INLINE_PDATA emptyPR #-} + emptyPR + = PTuple4 emptyPR emptyPR emptyPR emptyPR + + + {-# INLINE_PDATA replicatePR #-} + replicatePR len (x, y, z, d) + = PTuple4 (replicatePR len x) + (replicatePR len y) + (replicatePR len z) + (replicatePR len d) + + + {-# INLINE_PDATA replicatesPR #-} + replicatesPR lens (PTuple4 arr1 arr2 arr3 arr4) + = PTuple4 (replicatesPR lens arr1) + (replicatesPR lens arr2) + (replicatesPR lens arr3) + (replicatesPR lens arr4) + + + {-# INLINE_PDATA appendPR #-} + appendPR (PTuple4 arr11 arr12 arr13 arr14) + (PTuple4 arr21 arr22 arr23 arr24) + = PTuple4 (arr11 `appendPR` arr21) + (arr12 `appendPR` arr22) + (arr13 `appendPR` arr23) + (arr14 `appendPR` arr24) + + + {-# INLINE_PDATA appendsPR #-} + appendsPR segdResult segd1 (PTuple4 arrs11 arrs12 arrs13 arrs14) + segd2 (PTuple4 arrs21 arrs22 arrs23 arrs24) + = PTuple4 (appendsPR segdResult segd1 arrs11 segd2 arrs21) + (appendsPR segdResult segd1 arrs12 segd2 arrs22) + (appendsPR segdResult segd1 arrs13 segd2 arrs23) + (appendsPR segdResult segd1 arrs14 segd2 arrs24) + + + -- Projections --------------------------------- + {-# INLINE_PDATA lengthPR #-} + lengthPR (PTuple4 arr1 _ _ _) + = lengthPR arr1 + + {-# INLINE_PDATA indexPR #-} + indexPR (PTuple4 arr1 arr2 arr3 arr4) ix + = ( indexPR arr1 ix + , indexPR arr2 ix + , indexPR arr3 ix + , indexPR arr4 ix) + + + {-# INLINE_PDATA indexsPR #-} + indexsPR (PTuple4s xs ys zs ds) srcixs + = PTuple4 (indexsPR xs srcixs) + (indexsPR ys srcixs) + (indexsPR zs srcixs) + (indexsPR ds srcixs) + + {-# INLINE_PDATA indexvsPR #-} + indexvsPR (PTuple4s xs ys zs ds) vsegd srcixs + = PTuple4 (indexvsPR xs vsegd srcixs) + (indexvsPR ys vsegd srcixs) + (indexvsPR zs vsegd srcixs) + (indexvsPR ds vsegd srcixs) + + {-# INLINE_PDATA extractPR #-} + extractPR (PTuple4 arr1 arr2 arr3 arr4) start len + = PTuple4 (extractPR arr1 start len) + (extractPR arr2 start len) + (extractPR arr3 start len) + (extractPR arr4 start len) + + {-# INLINE_PDATA extractssPR #-} + extractssPR (PTuple4s xs ys zs ds) ussegd + = PTuple4 (extractssPR xs ussegd) + (extractssPR ys ussegd) + (extractssPR zs ussegd) + (extractssPR ds ussegd) + + {-# INLINE_PDATA extractvsPR #-} + extractvsPR (PTuple4s xs ys zs ds) uvsegd + = PTuple4 (extractvsPR xs uvsegd) + (extractvsPR ys uvsegd) + (extractvsPR zs uvsegd) + (extractvsPR ds uvsegd) + + + -- Pack and Combine --------------------------- + {-# INLINE_PDATA packByTagPR #-} + packByTagPR (PTuple4 arr1 arr2 arr3 arr4) tags tag + = PTuple4 (packByTagPR arr1 tags tag) + (packByTagPR arr2 tags tag) + (packByTagPR arr3 tags tag) + (packByTagPR arr4 tags tag) + + + {-# INLINE_PDATA combine2PR #-} + combine2PR sel (PTuple4 xs1 ys1 zs1 ds1) (PTuple4 xs2 ys2 zs2 ds2) + = PTuple4 (combine2PR sel xs1 xs2) + (combine2PR sel ys1 ys2) + (combine2PR sel zs1 zs2) + (combine2PR sel ds1 ds2) + + + -- Conversions -------------------------------- + {-# NOINLINE fromVectorPR #-} + fromVectorPR vec + = let (xs, ys, zs, ds) = V.unzip4 vec + in PTuple4 (fromVectorPR xs) + (fromVectorPR ys) + (fromVectorPR zs) + (fromVectorPR ds) + + {-# NOINLINE toVectorPR #-} + toVectorPR (PTuple4 xs ys zs ds) + = V.zip4 (toVectorPR xs) + (toVectorPR ys) + (toVectorPR zs) + (toVectorPR ds) + + + -- PData -------------------------------------- + {-# INLINE_PDATA emptydPR #-} + emptydPR + = PTuple4s emptydPR + emptydPR + emptydPR + emptydPR + + + {-# INLINE_PDATA singletondPR #-} + singletondPR (PTuple4 x y z d) + = PTuple4s (singletondPR x) + (singletondPR y) + (singletondPR z) + (singletondPR d) + + + {-# INLINE_PDATA lengthdPR #-} + lengthdPR (PTuple4s xs _ _ _) + = lengthdPR xs + + + {-# INLINE_PDATA indexdPR #-} + indexdPR (PTuple4s xs ys zs ds) i + = PTuple4 (indexdPR xs i) + (indexdPR ys i) + (indexdPR zs i) + (indexdPR ds i) + + + {-# INLINE_PDATA appenddPR #-} + appenddPR (PTuple4s xs1 ys1 zs1 ds1) (PTuple4s xs2 ys2 zs2 ds2) + = PTuple4s (appenddPR xs1 xs2) + (appenddPR ys1 ys2) + (appenddPR zs1 zs2) + (appenddPR ds1 ds2) + + + {-# NOINLINE fromVectordPR #-} + fromVectordPR vec + = let (xss, yss, zss, dss) = V.unzip4 $ V.map (\(PTuple4 xs ys zs ds) -> (xs, ys, zs, ds)) vec + in PTuple4s (fromVectordPR xss) + (fromVectordPR yss) + (fromVectordPR zss) + (fromVectordPR dss) + + + {-# NOINLINE toVectordPR #-} + toVectordPR (PTuple4s pdatas1 pdatas2 pdatas3 pdatas4) + = V.zipWith4 PTuple4 + (toVectordPR pdatas1) + (toVectordPR pdatas2) + (toVectordPR pdatas3) + (toVectordPR pdatas4) + + +-- PD Functions --------------------------------------------------------------- +-- | O(1). Zip a pair of arrays into an array of pairs. +zip4PD :: PData a -> PData b -> PData c -> PData d -> PData (a, b, c, d) +zip4PD = PTuple4 +{-# INLINE_PA zip4PD #-} + + +-- Show ----------------------------------------------------------------------- +deriving instance (Show (PData a), Show (PData b), Show (PData c), Show (PData d)) + => Show (PData (a, b, c, d)) + +deriving instance (Show (PDatas a), Show (PDatas b), Show (PDatas c), Show (PDatas d)) + => Show (PDatas (a, b, c, d)) + + +instance ( PR a, PR b, PR c, PR d, Show a, Show b, Show c, Show d + , PprVirtual (PData a), PprVirtual (PData b), PprVirtual (PData c), PprVirtual (PData d)) + => PprVirtual (PData (a, b, c, d)) where + pprv (PTuple4 xs ys zs ds) + = text $ show + $ P.zip4 (V.toList $ toVectorPR xs) + (V.toList $ toVectorPR ys) + (V.toList $ toVectorPR zs) + (V.toList $ toVectorPR ds) + + + diff --git a/Data/Array/Parallel/PArray/PData/Tuple5.hs b/Data/Array/Parallel/PArray/PData/Tuple5.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PData/Tuple5.hs @@ -0,0 +1,304 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | PR instance for tuples. +module Data.Array.Parallel.PArray.PData.Tuple5 + ( PData(..), PDatas(..) + , zip5PD) +where +import Data.Array.Parallel.Pretty +import Data.Array.Parallel.PArray.PData.Base +import Data.Array.Parallel.PArray.PData.Nested +import GHC.Exts +import Prelude hiding (zip, unzip) +import qualified Data.Vector as V +import qualified Prelude as P +import qualified Data.List as P + +------------------------------------------------------------------------------- +data instance PData (a, b, c, d, e) + = PTuple5 (PData a) (PData b) (PData c) (PData d) (PData e) + +data instance PDatas (a, b, c, d, e) + = PTuple5s (PDatas a) (PDatas b) (PDatas c) (PDatas d) (PDatas e) + + +-- PR ------------------------------------------------------------------------- +instance (PR a, PR b, PR c, PR d, PR e) => PR (a, b, c, d, e) where + + {-# NOINLINE validPR #-} + validPR (PTuple5 xs ys zs ds es) + = validPR xs && validPR ys && validPR zs && validPR ds && validPR es + + + {-# NOINLINE nfPR #-} + nfPR (PTuple5 arr1 arr2 arr3 arr4 arr5) + = nfPR arr1 `seq` nfPR arr2 `seq` nfPR arr3 `seq` nfPR arr4 `seq` nfPR arr5 `seq` () + + + {-# NOINLINE similarPR #-} + similarPR (x1, y1, z1, d1, e1) (x2, y2, z2, d2, e2) + = similarPR x1 x2 + && similarPR y1 y2 + && similarPR z1 z2 + && similarPR d1 d2 + && similarPR e1 e2 + + + {-# NOINLINE coversPR #-} + coversPR weak (PTuple5 arr1 arr2 arr3 arr4 arr5) ix + = coversPR weak arr1 ix + && coversPR weak arr2 ix + && coversPR weak arr3 ix + && coversPR weak arr4 ix + && coversPR weak arr5 ix + + + {-# NOINLINE pprpPR #-} + pprpPR (x, y, z, d, e) + = text "Tuple5 " + <> vcat [ pprpPR x + , pprpPR y + , pprpPR z + , pprpPR d + , pprpPR e ] + + + {-# NOINLINE pprpDataPR #-} + pprpDataPR (PTuple5 xs ys zs ds es) + = text "PTuple5 " + <> vcat [ pprpDataPR xs + , pprpDataPR ys + , pprpDataPR zs + , pprpDataPR ds + , pprpDataPR es] + + + -- Constructors ------------------------------- + {-# INLINE_PDATA emptyPR #-} + emptyPR + = PTuple5 emptyPR emptyPR emptyPR emptyPR emptyPR + + + {-# INLINE_PDATA replicatePR #-} + replicatePR len (x, y, z, d, e) + = PTuple5 (replicatePR len x) + (replicatePR len y) + (replicatePR len z) + (replicatePR len d) + (replicatePR len e) + + + {-# INLINE_PDATA replicatesPR #-} + replicatesPR lens (PTuple5 arr1 arr2 arr3 arr4 arr5) + = PTuple5 (replicatesPR lens arr1) + (replicatesPR lens arr2) + (replicatesPR lens arr3) + (replicatesPR lens arr4) + (replicatesPR lens arr5) + + + {-# INLINE_PDATA appendPR #-} + appendPR (PTuple5 arr11 arr12 arr13 arr14 arr15) + (PTuple5 arr21 arr22 arr23 arr24 arr25) + = PTuple5 (arr11 `appendPR` arr21) + (arr12 `appendPR` arr22) + (arr13 `appendPR` arr23) + (arr14 `appendPR` arr24) + (arr15 `appendPR` arr25) + + + {-# INLINE_PDATA appendsPR #-} + appendsPR segdResult segd1 (PTuple5 arrs11 arrs12 arrs13 arrs14 arrs15) + segd2 (PTuple5 arrs21 arrs22 arrs23 arrs24 arrs25) + = PTuple5 (appendsPR segdResult segd1 arrs11 segd2 arrs21) + (appendsPR segdResult segd1 arrs12 segd2 arrs22) + (appendsPR segdResult segd1 arrs13 segd2 arrs23) + (appendsPR segdResult segd1 arrs14 segd2 arrs24) + (appendsPR segdResult segd1 arrs15 segd2 arrs25) + + + -- Projections --------------------------------- + {-# INLINE_PDATA lengthPR #-} + lengthPR (PTuple5 arr1 _ _ _ _) + = lengthPR arr1 + + {-# INLINE_PDATA indexPR #-} + indexPR (PTuple5 arr1 arr2 arr3 arr4 arr5) ix + = ( indexPR arr1 ix + , indexPR arr2 ix + , indexPR arr3 ix + , indexPR arr4 ix + , indexPR arr5 ix) + + + {-# INLINE_PDATA indexsPR #-} + indexsPR (PTuple5s xs ys zs ds es) srcixs + = PTuple5 (indexsPR xs srcixs) + (indexsPR ys srcixs) + (indexsPR zs srcixs) + (indexsPR ds srcixs) + (indexsPR es srcixs) + + {-# INLINE_PDATA indexvsPR #-} + indexvsPR (PTuple5s xs ys zs ds es) vsegd srcixs + = PTuple5 (indexvsPR xs vsegd srcixs) + (indexvsPR ys vsegd srcixs) + (indexvsPR zs vsegd srcixs) + (indexvsPR ds vsegd srcixs) + (indexvsPR es vsegd srcixs) + + {-# INLINE_PDATA extractPR #-} + extractPR (PTuple5 arr1 arr2 arr3 arr4 arr5) start len + = PTuple5 (extractPR arr1 start len) + (extractPR arr2 start len) + (extractPR arr3 start len) + (extractPR arr4 start len) + (extractPR arr5 start len) + + {-# INLINE_PDATA extractssPR #-} + extractssPR (PTuple5s xs ys zs ds es) ussegd + = PTuple5 (extractssPR xs ussegd) + (extractssPR ys ussegd) + (extractssPR zs ussegd) + (extractssPR ds ussegd) + (extractssPR es ussegd) + + {-# INLINE_PDATA extractvsPR #-} + extractvsPR (PTuple5s xs ys zs ds es) uvsegd + = PTuple5 (extractvsPR xs uvsegd) + (extractvsPR ys uvsegd) + (extractvsPR zs uvsegd) + (extractvsPR ds uvsegd) + (extractvsPR es uvsegd) + + + -- Pack and Combine --------------------------- + {-# INLINE_PDATA packByTagPR #-} + packByTagPR (PTuple5 arr1 arr2 arr3 arr4 arr5) tags tag + = PTuple5 (packByTagPR arr1 tags tag) + (packByTagPR arr2 tags tag) + (packByTagPR arr3 tags tag) + (packByTagPR arr4 tags tag) + (packByTagPR arr5 tags tag) + + + {-# INLINE_PDATA combine2PR #-} + combine2PR sel (PTuple5 xs1 ys1 zs1 ds1 es1) (PTuple5 xs2 ys2 zs2 ds2 es2) + = PTuple5 (combine2PR sel xs1 xs2) + (combine2PR sel ys1 ys2) + (combine2PR sel zs1 zs2) + (combine2PR sel ds1 ds2) + (combine2PR sel es1 es2) + + + -- Conversions -------------------------------- + {-# NOINLINE fromVectorPR #-} + fromVectorPR vec + = let (xs, ys, zs, ds, es) = V.unzip5 vec + in PTuple5 (fromVectorPR xs) + (fromVectorPR ys) + (fromVectorPR zs) + (fromVectorPR ds) + (fromVectorPR es) + + {-# NOINLINE toVectorPR #-} + toVectorPR (PTuple5 xs ys zs ds es) + = V.zip5 (toVectorPR xs) + (toVectorPR ys) + (toVectorPR zs) + (toVectorPR ds) + (toVectorPR es) + + + -- PData -------------------------------------- + {-# INLINE_PDATA emptydPR #-} + emptydPR + = PTuple5s emptydPR + emptydPR + emptydPR + emptydPR + emptydPR + + + {-# INLINE_PDATA singletondPR #-} + singletondPR (PTuple5 x y z d e) + = PTuple5s (singletondPR x) + (singletondPR y) + (singletondPR z) + (singletondPR d) + (singletondPR e) + + + {-# INLINE_PDATA lengthdPR #-} + lengthdPR (PTuple5s xs _ _ _ _) + = lengthdPR xs + + + {-# INLINE_PDATA indexdPR #-} + indexdPR (PTuple5s xs ys zs ds es) i + = PTuple5 (indexdPR xs i) + (indexdPR ys i) + (indexdPR zs i) + (indexdPR ds i) + (indexdPR es i) + + + {-# INLINE_PDATA appenddPR #-} + appenddPR (PTuple5s xs1 ys1 zs1 ds1 es1) (PTuple5s xs2 ys2 zs2 ds2 es2) + = PTuple5s (appenddPR xs1 xs2) + (appenddPR ys1 ys2) + (appenddPR zs1 zs2) + (appenddPR ds1 ds2) + (appenddPR es1 es2) + + + {-# NOINLINE fromVectordPR #-} + fromVectordPR vec + = let (xss, yss, zss, dss, ess) = V.unzip5 $ V.map (\(PTuple5 xs ys zs ds es) -> (xs, ys, zs, ds, es)) vec + in PTuple5s (fromVectordPR xss) + (fromVectordPR yss) + (fromVectordPR zss) + (fromVectordPR dss) + (fromVectordPR ess) + + + {-# NOINLINE toVectordPR #-} + toVectordPR (PTuple5s pdatas1 pdatas2 pdatas3 pdatas4 pdatas5) + = V.zipWith5 PTuple5 + (toVectordPR pdatas1) + (toVectordPR pdatas2) + (toVectordPR pdatas3) + (toVectordPR pdatas4) + (toVectordPR pdatas5) + + +-- PD Functions --------------------------------------------------------------- +-- | O(1). Zip a pair of arrays into an array of pairs. +zip5PD :: PData a -> PData b -> PData c -> PData d -> PData e -> PData (a, b, c, d, e) +zip5PD = PTuple5 +{-# INLINE_PA zip5PD #-} + + +-- Show ----------------------------------------------------------------------- +deriving instance (Show (PData a), Show (PData b), Show (PData c), Show (PData d), Show (PData e)) + => Show (PData (a, b, c, d, e)) + +deriving instance (Show (PDatas a), Show (PDatas b), Show (PDatas c), Show (PDatas d), Show (PDatas e)) + => Show (PDatas (a, b, c, d, e)) + + +instance ( PR a, PR b, PR c, PR d, PR e, Show a, Show b, Show c, Show d, Show e + , PprVirtual (PData a), PprVirtual (PData b), PprVirtual (PData c), PprVirtual (PData d), PprVirtual (PData e)) + => PprVirtual (PData (a, b, c, d, e)) where + pprv (PTuple5 xs ys zs ds es) + = text $ show + $ P.zip5 (V.toList $ toVectorPR xs) + (V.toList $ toVectorPR ys) + (V.toList $ toVectorPR zs) + (V.toList $ toVectorPR ds) + (V.toList $ toVectorPR es) + + + diff --git a/Data/Array/Parallel/PArray/PData/Unit.hs b/Data/Array/Parallel/PArray/PData/Unit.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PData/Unit.hs @@ -0,0 +1,164 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | PR instance for unit. +module Data.Array.Parallel.PArray.PData.Unit where +import Data.Array.Parallel.PArray.PData.Base +import Data.Array.Parallel.Pretty +import qualified Data.Array.Parallel.Unlifted as U +import qualified Data.Vector as V + +------------------------------------------------------------------------------- +-- | TODO: For arrays of units, we're currently maintaining their length so +-- that validPR works properly. In future we should ditch the length field +-- and rely on coversPR to check that indices are in bounds, like we do +-- with arrays of type PData Void. +data instance PData () + = PUnit Int + +data instance PDatas () + = PUnits (U.Array Int) + +punit :: Int -> PData () +punit = PUnit + + +-- PR ------------------------------------------------------------------------- +instance PR () where + + {-# NOINLINE validPR #-} + validPR _ + = True + + {-# NOINLINE nfPR #-} + nfPR xx + = xx `seq` () + + {-# NOINLINE similarPR #-} + similarPR _ _ + = True + + {-# NOINLINE coversPR #-} + coversPR weak (PUnit n) i + | weak = i <= n + | otherwise = i < n + + {-# NOINLINE pprpPR #-} + pprpPR _ + = text "()" + + {-# NOINLINE pprpDataPR #-} + pprpDataPR uu + = text $ show uu + + + -- Constructors ------------------------------- + {-# INLINE_PDATA emptyPR #-} + emptyPR + = PUnit 0 + + {-# INLINE_PDATA replicatePR #-} + replicatePR n _ + = PUnit n + + {-# INLINE_PDATA replicatesPR #-} + replicatesPR segd _ + = PUnit (U.elementsSegd segd) + + {-# INLINE_PDATA appendPR #-} + appendPR (PUnit len1) (PUnit len2) + = PUnit (len1 + len2) + + {-# INLINE_PDATA appendsPR #-} + appendsPR segdResult _ _ _ _ + = PUnit (U.lengthSegd segdResult) + + + -- Projections ------------------------------- + {-# INLINE_PDATA lengthPR #-} + lengthPR (PUnit n) + = n + + {-# INLINE_PDATA indexPR #-} + indexPR _ _ + = () + + {-# INLINE_PDATA indexsPR #-} + indexsPR _ srcixs + = PUnit $ U.length srcixs + + {-# INLINE_PDATA indexvsPR #-} + indexvsPR _ _ srcixs + = PUnit $ U.length srcixs + + {-# INLINE_PDATA extractPR #-} + extractPR _ _ len + = PUnit len + + {-# INLINE_PDATA extractssPR #-} + extractssPR _ ussegd + = PUnit $ U.sum $ U.lengthsOfSSegd ussegd + + {-# INLINE_PDATA extractvsPR #-} + extractvsPR _ uvsegd + = PUnit $ U.sum $ U.takeLengthsOfVSegd uvsegd + + + -- Pack and Combine --------------------------- + {-# INLINE_PDATA packByTagPR #-} + packByTagPR _ tags tag + = PUnit (U.length $ U.filter (== tag) tags) + + {-# INLINE_PDATA combine2PR #-} + combine2PR sel2 _ _ + = PUnit ( U.elementsSel2_0 sel2 + + U.elementsSel2_1 sel2) + + + -- Conversions -------------------------------- + {-# NOINLINE fromVectorPR #-} + fromVectorPR vec + = PUnit (V.length vec) + + {-# NOINLINE toVectorPR #-} + toVectorPR (PUnit len) + = V.replicate len () + + -- PDatas ------------------------------------- + {-# INLINE_PDATA emptydPR #-} + emptydPR + = PUnits $ U.empty + + {-# INLINE_PDATA singletondPR #-} + singletondPR (PUnit n) + = PUnits $ U.replicate 1 n + + {-# INLINE_PDATA lengthdPR #-} + lengthdPR (PUnits pdatas) + = U.length pdatas + + {-# INLINE_PDATA indexdPR #-} + indexdPR (PUnits pdatas) ix + = PUnit $ U.index "indexdPR[Unit]" pdatas ix + + {-# INLINE_PDATA appenddPR #-} + appenddPR (PUnits lens1) (PUnits lens2) + = PUnits $ lens1 U.+:+ lens2 + + {-# NOINLINE fromVectordPR #-} + fromVectordPR vec + = PUnits $ V.convert $ V.map lengthPR vec + + {-# NOINLINE toVectordPR #-} + toVectordPR (PUnits uvecs) + = V.map PUnit $ V.convert uvecs + +-- Show ----------------------------------------------------------------------- +deriving instance Show (PData ()) +deriving instance Show (PDatas ()) + +instance PprVirtual (PData ()) where + pprv (PUnit n) + = text $ "[ () x " ++ show n ++ " ]" + diff --git a/Data/Array/Parallel/PArray/PData/Void.hs b/Data/Array/Parallel/PArray/PData/Void.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PData/Void.hs @@ -0,0 +1,166 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | PR instance for the void type. +module Data.Array.Parallel.PArray.PData.Void + (Void, void, pvoid, fromVoid, pvoids) +where +import Data.Array.Parallel.PArray.PData.Base +import Data.Array.Parallel.PArray.PRepr.Base () +import Data.Array.Parallel.PArray.Types +import Data.Array.Parallel.Pretty +import qualified Data.Vector as V + +------------------------------------------------------------------------------- +-- | The Void type is used as a place holder in situations where we don't +-- want to track a real array. +-- +-- For example: +-- A type like Bool is represented as @Sum2 Void Void@, meaning that we only +-- only care about the tag of the data constructor and not its argumnent. +-- +-- We also use it as the to fill empty closures. +-- +-- Note that arrays of (PData Void) do not have an intrinsic length, which +-- is the reason that the PR dictionary only contains a coversPR function +-- was well as a partial lengthPR function. +-- +data instance PData Void + +-- | PVoids instance counts how many "vectors" of void we have +data instance PDatas Void + = PVoids Int + +pvoid :: PData Void +pvoid = error "Data.Array.Parallel.PData.Void" + +pvoids :: Int -> PDatas Void +pvoids = PVoids + + +-- PR -------------------------------------------------------------------------- +nope :: String -> a +nope str = error $ "Data.Array.Parallel.PData.Void: no PR method for " ++ str + +instance PR Void where + + {-# NOINLINE validPR #-} + validPR _ = True + + {-# NOINLINE nfPR #-} + nfPR _ = () + + {-# NOINLINE similarPR #-} + similarPR _ _ = True + + {-# NOINLINE coversPR #-} + coversPR _ _ _ = True + + {-# NOINLINE pprpPR #-} + pprpPR _ = text "void" + + {-# NOINLINE pprpDataPR #-} + pprpDataPR _ = text "pvoid" + + + -- Constructors ------------------------------- + {-# INLINE_PDATA emptyPR #-} + emptyPR = nope "emptyPR" + + {-# INLINE_PDATA replicatePR #-} + replicatePR = nope "replicate" + + {-# INLINE_PDATA replicatesPR #-} + replicatesPR = nope "replicates" + + {-# INLINE_PDATA appendPR #-} + appendPR = nope "append" + + {-# INLINE_PDATA appendsPR #-} + appendsPR = nope "appends" + + + -- Projections -------------------------------- + {-# INLINE_PDATA lengthPR #-} + lengthPR _ = nope "length" + + -- We return the black hole here so that we can construct vectors of type + -- Vector Void during debugging. + -- See the (A.Array PArray e) instance in D.A.P.PArray for details. + {-# INLINE_PDATA indexPR #-} + indexPR _ _ = void + + {-# INLINE_PDATA indexsPR #-} + indexsPR = nope "indexs" + + {-# INLINE_PDATA indexvsPR #-} + indexvsPR = nope "indexvs" + + {-# INLINE_PDATA extractPR #-} + extractPR = nope "extractl" + + {-# INLINE_PDATA extractssPR #-} + extractssPR = nope "extractss" + + {-# INLINE_PDATA extractvsPR #-} + extractvsPR = nope "extractvs" + + + -- Pack and Combine --------------------------- + {-# INLINE_PDATA packByTagPR #-} + packByTagPR = nope "packByTag" + + {-# INLINE_PDATA combine2PR #-} + combine2PR = nope "combine2" + + + -- Conversions -------------------------------- + {-# NOINLINE fromVectorPR #-} + fromVectorPR = nope "fromVector" + + {-# NOINLINE toVectorPR #-} + toVectorPR _ = nope "toVector" + + + -- PDatas ------------------------------------- + {-# INLINE_PDATA emptydPR #-} + emptydPR = PVoids 0 + + {-# INLINE_PDATA singletondPR #-} + singletondPR _ + = PVoids 1 + + {-# INLINE_PDATA lengthdPR #-} + lengthdPR (PVoids n) + = n + + {-# INLINE_PDATA indexdPR #-} + indexdPR _ _ + = pvoid + + {-# INLINE_PDATA appenddPR #-} + appenddPR (PVoids n1) (PVoids n2) + = PVoids (n1 + n2) + + {-# NOINLINE fromVectordPR #-} + fromVectordPR vec + = PVoids $ V.length vec + + {-# NOINLINE toVectordPR #-} + toVectordPR (PVoids n) + = V.replicate n pvoid + + +-- Show ----------------------------------------------------------------------- +instance Show (PData Void) where + show _ = "pvoid" + + +instance Show (PDatas Void) where + show _ = "pvoids" + + +instance PprVirtual (PData Void) where + pprv _ = text "pvoid" + diff --git a/Data/Array/Parallel/PArray/PData/Word8.hs b/Data/Array/Parallel/PArray/PData/Word8.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PData/Word8.hs @@ -0,0 +1,168 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | PR instance for Word8. +module Data.Array.Parallel.PArray.PData.Word8 where +import Data.Array.Parallel.PArray.PData.Base +import qualified Data.Array.Parallel.Unlifted as U +import qualified Data.Vector as V +import Text.PrettyPrint +import Prelude as P +import Data.Word +import Data.Array.Parallel.Pretty + +------------------------------------------------------------------------------- +data instance PData Word8 + = PWord8 (U.Array Word8) + +data instance PDatas Word8 + = PWord8s (U.Arrays Word8) + + +-- PR ------------------------------------------------------------------------- +instance PR Word8 where + + {-# NOINLINE validPR #-} + validPR _ + = True + + {-# NOINLINE nfPR #-} + nfPR (PWord8 xx) + = xx `seq` () + + {-# NOINLINE similarPR #-} + similarPR = (==) + + {-# NOINLINE coversPR #-} + coversPR weak (PWord8 uarr) ix + | weak = ix <= U.length uarr + | otherwise = ix < U.length uarr + + {-# NOINLINE pprpPR #-} + pprpPR i + = int (fromIntegral i) + + {-# NOINLINE pprpDataPR #-} + pprpDataPR (PWord8 uarr) + = text "PWord8" <+> pprp uarr + + + -- Constructors ------------------------------- + {-# INLINE_PDATA emptyPR #-} + emptyPR + = PWord8 U.empty + + {-# INLINE_PDATA replicatePR #-} + replicatePR len x + = PWord8 (U.replicate len x) + + {-# INLINE_PDATA replicatesPR #-} + replicatesPR segd (PWord8 arr) + = PWord8 (U.replicate_s segd arr) + + {-# INLINE_PDATA appendPR #-} + appendPR (PWord8 arr1) (PWord8 arr2) + = PWord8 $ arr1 U.+:+ arr2 + + {-# INLINE_PDATA appendsPR #-} + appendsPR segdResult segd1 (PWord8 arr1) segd2 (PWord8 arr2) + = PWord8 $ U.append_s segdResult segd1 arr1 segd2 arr2 + + + -- Projections -------------------------------- + {-# INLINE_PDATA lengthPR #-} + lengthPR (PWord8 uarr) + = U.length uarr + + {-# INLINE_PDATA indexPR #-} + indexPR (PWord8 uarr) ix + = U.index "indexPR[Word8]" uarr ix + + {-# INLINE_PDATA indexsPR #-} + indexsPR (PWord8s pvecs) srcixs + = PWord8 $ U.map (\(src, ix) -> U.unsafeIndex2s pvecs src ix) srcixs + + {-# INLINE_PDATA indexvsPR #-} + indexvsPR (PWord8s arrs) vsegd srcixs + = PWord8 $ U.indexs_avs arrs vsegd srcixs + + {-# INLINE_PDATA extractPR #-} + extractPR (PWord8 arr) start len + = PWord8 (U.extract arr start len) + + {-# INLINE_PDATA extractssPR #-} + extractssPR (PWord8s arrs) ssegd + = PWord8 $ U.extracts_ass ssegd arrs + + {-# INLINE_PDATA extractvsPR #-} + extractvsPR (PWord8s arrs) vsegd + = PWord8 $ U.extracts_avs vsegd arrs + + + -- Pack and Combine --------------------------- + {-# INLINE_PDATA packByTagPR #-} + packByTagPR (PWord8 arr1) arrTags tag + = PWord8 $ U.packByTag arr1 arrTags tag + + {-# INLINE_PDATA combine2PR #-} + combine2PR sel (PWord8 arr1) (PWord8 arr2) + = PWord8 $ U.combine2 (U.tagsSel2 sel) + (U.repSel2 sel) + arr1 arr2 + + + -- Conversions -------------------------------- + {-# NOINLINE fromVectorPR #-} + fromVectorPR xx + = PWord8 $U.fromList $ V.toList xx + + {-# NOINLINE toVectorPR #-} + toVectorPR (PWord8 arr) + = V.fromList $ U.toList arr + + + -- PDatas ------------------------------------- + {-# INLINE_PDATA emptydPR #-} + emptydPR + = PWord8s $ U.emptys + + {-# INLINE_PDATA singletondPR #-} + singletondPR (PWord8 pdata) + = PWord8s $ U.singletons pdata + + {-# INLINE_PDATA lengthdPR #-} + lengthdPR (PWord8s arrs) + = U.lengths arrs + + {-# INLINE_PDATA indexdPR #-} + indexdPR (PWord8s arrs) ix + = PWord8 $ arrs `U.unsafeIndexs` ix + + {-# INLINE_PDATA appenddPR #-} + appenddPR (PWord8s xs) (PWord8s ys) + = PWord8s $ xs `U.appends` ys + + {-# NOINLINE fromVectordPR #-} + fromVectordPR pdatas + = PWord8s + $ U.fromVectors + $ V.map (\(PWord8 xs) -> xs) pdatas + + {-# NOINLINE toVectordPR #-} + toVectordPR (PWord8s vec) + = V.map PWord8 $ U.toVectors vec + + +-- Show ----------------------------------------------------------------------- +deriving instance Show (PData Word8) +deriving instance Show (PDatas Word8) + +instance PprPhysical (U.Array Word8) where + pprp uarr + = text (show $ U.toList uarr) + +instance PprVirtual (PData Word8) where + pprv (PWord8 vec) + = text (show $ U.toList vec) + diff --git a/Data/Array/Parallel/PArray/PData/Wrap.hs b/Data/Array/Parallel/PArray/PData/Wrap.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PData/Wrap.hs @@ -0,0 +1,150 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | PR instance for the Wrap type. +module Data.Array.Parallel.PArray.PData.Wrap where +import Data.Array.Parallel.PArray.PData.Base +import Data.Array.Parallel.PArray.Types +import Data.Array.Parallel.PArray.PRepr.Base +import qualified Data.Vector as V + +------------------------------------------------------------------------------- +newtype instance PData (Wrap a) + = PWrap (PData a) + +newtype instance PDatas (Wrap a) + = PWraps (PDatas a) + + +-- PR ------------------------------------------------------------------------- +instance PA a => PR (Wrap a) where + + {-# NOINLINE validPR #-} + validPR (PWrap pdata) + = validPA pdata + + {-# NOINLINE nfPR #-} + nfPR (PWrap pdata) + = nfPA pdata + + {-# NOINLINE similarPR #-} + similarPR (Wrap x) (Wrap y) + = similarPA x y + + {-# NOINLINE coversPR #-} + coversPR weak (PWrap pdata) ix + = coversPA weak pdata ix + + {-# NOINLINE pprpPR #-} + pprpPR (Wrap x) + = pprpPA x + + {-# NOINLINE pprpDataPR #-} + pprpDataPR (PWrap pdata) + = pprpDataPA pdata + + + -- Constructors ------------------------------- + {-# INLINE_PDATA emptyPR #-} + emptyPR + = PWrap emptyPA + + {-# INLINE_PDATA replicatePR #-} + replicatePR n (Wrap x) + = PWrap $ replicatePA n x + + {-# INLINE_PDATA replicatesPR #-} + replicatesPR segd (PWrap xs) + = PWrap $ replicatesPA segd xs + + {-# INLINE_PDATA appendPR #-} + appendPR (PWrap xs) (PWrap ys) + = PWrap $ appendPA xs ys + + {-# INLINE_PDATA appendsPR #-} + appendsPR segdResult segd1 (PWrap xs) segd2 (PWrap ys) + = PWrap $ appendsPA segdResult segd1 xs segd2 ys + + + -- Projections -------------------------------- + {-# INLINE_PDATA lengthPR #-} + lengthPR (PWrap xs) + = lengthPA xs + + {-# INLINE_PDATA indexPR #-} + indexPR (PWrap xs) ix + = Wrap $ indexPA xs ix + + {-# INLINE_PDATA indexsPR #-} + indexsPR (PWraps pdatas) srcixs + = PWrap $ indexsPA pdatas srcixs + + {-# INLINE_PDATA indexvsPR #-} + indexvsPR (PWraps arrs) vsegd srcixs + = PWrap $ indexvsPA arrs vsegd srcixs + + {-# INLINE_PDATA extractPR #-} + extractPR (PWrap xs) ix n + = PWrap $ extractPA xs ix n + + {-# INLINE_PDATA extractssPR #-} + extractssPR (PWraps pdatas) ssegd + = PWrap $ extractssPA pdatas ssegd + + {-# INLINE_PDATA extractvsPR #-} + extractvsPR (PWraps pdatas) vsegd + = PWrap $ extractvsPA pdatas vsegd + + + -- Pack and Combine --------------------------- + {-# INLINE_PDATA packByTagPR #-} + packByTagPR (PWrap xs) tags tag + = PWrap $ packByTagPA xs tags tag + + {-# INLINE_PDATA combine2PR #-} + combine2PR sel (PWrap xs) (PWrap ys) + = PWrap $ combine2PA sel xs ys + + + -- Conversions -------------------------------- + {-# NOINLINE fromVectorPR #-} + fromVectorPR vec + = PWrap $ fromVectorPA $ V.map unWrap vec + + {-# NOINLINE toVectorPR #-} + toVectorPR (PWrap pdata) + = V.map Wrap $ toVectorPA pdata + + + -- PDatas ------------------------------------- + {-# INLINE_PDATA emptydPR #-} + emptydPR + = PWraps emptydPA + + {-# INLINE_PDATA singletondPR #-} + singletondPR (PWrap pdata) + = PWraps $ singletondPA pdata + + {-# INLINE_PDATA lengthdPR #-} + lengthdPR (PWraps pdatas) + = lengthdPA pdatas + + {-# INLINE_PDATA indexdPR #-} + indexdPR (PWraps pdatas) ix + = PWrap $ indexdPA pdatas ix + + {-# INLINE_PDATA appenddPR #-} + appenddPR (PWraps xs) (PWraps ys) + = PWraps $ appenddPA xs ys + + {-# NOINLINE fromVectordPR #-} + fromVectordPR vec + = PWraps $ fromVectordPA $ V.map (\(PWrap x) -> x) vec + + {-# NOINLINE toVectordPR #-} + toVectordPR (PWraps pdatas) + = V.map PWrap $ toVectordPA pdatas + + + diff --git a/Data/Array/Parallel/PArray/PRepr.hs b/Data/Array/Parallel/PArray/PRepr.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PRepr.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | Defines the `PRepr` family and `PA` class that converts between the user +-- level element types and our generic representation. +-- Apart from `unpackPA`, the `PA` wrapper functions defined here all have +-- equivalent `PR` versions in "Data.Array.Parallel.PArray.PData", +-- so see there for documentation. +module Data.Array.Parallel.PArray.PRepr + ( module Data.Array.Parallel.PArray.PRepr.Base + , module Data.Array.Parallel.PArray.PRepr.Instances + + -- * Nested Arrays + , module Data.Array.Parallel.PArray.PRepr.Nested + , unpackPA + + -- * Tuple Arrays + , module Data.Array.Parallel.PArray.PRepr.Tuple) +where +import Data.Array.Parallel.PArray.PRepr.Base +import Data.Array.Parallel.PArray.PRepr.Instances +import Data.Array.Parallel.PArray.PRepr.Nested +import Data.Array.Parallel.PArray.PRepr.Tuple +import Data.Array.Parallel.PArray.PData +import Data.Array.Parallel.Pretty +import qualified Data.Vector as V + + +-- Pretty ------------------------------------------------------------------- +instance (Show a, PA a) + => Show (PArray a) where + show (PArray _ pdata) + = render + $ brackets + $ text "|" + <> (hcat $ punctuate comma + $ map (text . show) $ V.toList $ toVectorPA pdata) + <> text "|" + + +instance (PprVirtual a, PA a) + => PprVirtual (PArray a) where + pprv (PArray _ pdata) + = brackets + $ text "|" + <> (hcat $ punctuate comma + $ map pprv $ V.toList $ toVectorPA pdata) + <> text "|" + + +-- Unpack ---------------------------------------------------------------------- +-- | Unpack an array to reveal its representation. +{-# INLINE_PA unpackPA #-} +unpackPA :: PA a => PArray a -> PData (PRepr a) +unpackPA (PArray _ pdata) + = toArrPRepr pdata diff --git a/Data/Array/Parallel/PArray/PRepr/Base.hs b/Data/Array/Parallel/PArray/PRepr/Base.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PRepr/Base.hs @@ -0,0 +1,312 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | Definition of the PRepr/PA family and class. +-- This module manages the conversion between the user level view of the +-- element data, and our internal generic view. +module Data.Array.Parallel.PArray.PRepr.Base + ( PRepr + , PA (..) + , toNestedArrPRepr + + -- * House Keeping + , validPA + , nfPA + , similarPA + , coversPA + , pprpPA + , pprpDataPA + + -- * Constructors + , emptyPA + , replicatePA, replicatesPA + , appendPA, appendsPA + + -- * Projections + , lengthPA + , indexPA, indexsPA, indexvsPA + , bpermutePA + , extractPA, extractssPA, extractvsPA + + -- * Pack and Combine + , packByTagPA + , combine2PA + + -- * Conversions + , fromVectorPA, toVectorPA + + -- * PDatas + , emptydPA + , singletondPA + , lengthdPA + , indexdPA + , appenddPA + , fromVectordPA, toVectordPA) +where +import Data.Array.Parallel.Pretty +import Data.Array.Parallel.PArray.PData.Base +import Data.Array.Parallel.PArray.PData.Nested +import Data.Array.Parallel.Base (Tag) +import Data.Vector (Vector) +import qualified Data.Array.Parallel.Unlifted as U +import qualified Data.Vector as V + +-- PRepr / PA ----------------------------------------------------------------- +-- | Family of Representable types. These are the types that we know how to +-- represent generically. `PRepr` takes an arbitrary type and produces the +-- generic type we use to represent it. +-- +-- Instances for simple types are defined by the library. +-- For algebraic types, it's up to the vectoriser/client module to create +-- a suitable instance. +-- +type family PRepr a + + +-- | A PA dictionary contains the functions that we use to convert a +-- representable type to and from its generic representation. +-- +-- The conversions methods should all be O(1). +class PR (PRepr a) => PA a where + toPRepr :: a -> PRepr a + fromPRepr :: PRepr a -> a + + toArrPRepr :: PData a -> PData (PRepr a) + fromArrPRepr :: PData (PRepr a) -> PData a + + toArrPReprs :: PDatas a -> PDatas (PRepr a) + fromArrPReprs :: PDatas (PRepr a) -> PDatas a + + +-- | Convert a nested array to its generic representation. +toNestedArrPRepr + :: PA a + => PData (PArray a) + -> PData (PArray (PRepr a)) + +toNestedArrPRepr (PNested vsegd pdatas segd flat) + = PNested vsegd (toArrPReprs pdatas) segd (toArrPRepr flat) + + +-- PA Wrappers ---------------------------------------------------------------- +-- These wrappers work on (PData a) arrays when we know the element type 'a' +-- is generically representable. We implement the array operators by converting +-- the PData to our generic representation type, and use the corresponding +-- method from the PR dictionary. +-- +-- The wrappers are used in situations when we only have PA dictionary, +-- instead of a PR dictionary. This happens in the PR (a :-> b) instance, +-- as we need to work on a generically represented environment, and only +-- have an existential PA dictionary. We also use them in the PA functions +-- defined by D.A.P.PArray. +-- +-- See the D.A.P.PArray.PData.Base for docs on what these functions do. +-- Each of the following functions has a corresponding method in the PR class. +-- +{-# INLINE_PA validPA #-} +validPA :: PA a => PData a -> Bool +validPA arr + = validPR (toArrPRepr arr) + + +{-# INLINE_PA nfPA #-} +nfPA :: PA a => PData a -> () +nfPA arr + = nfPR + $ toArrPRepr arr + + +{-# INLINE_PA similarPA #-} +similarPA :: PA a => a -> a -> Bool +similarPA x y + = similarPR (toPRepr x) (toPRepr y) + + +{-# INLINE_PA coversPA #-} +coversPA :: PA a => Bool -> PData a -> Int -> Bool +coversPA weak pdata ix + = coversPR weak (toArrPRepr pdata) ix + + +{-# INLINE_PA pprpPA #-} +pprpPA :: PA a => a -> Doc +pprpPA x + = pprpPR (toPRepr x) + + +{-# INLINE_PA pprpDataPA #-} +pprpDataPA :: PA a => PData a -> Doc +pprpDataPA x + = pprpDataPR (toArrPRepr x) + + +-- Constructors --------------------------------- +{-# INLINE_PA emptyPA #-} +emptyPA :: PA a => PData a +emptyPA + = fromArrPRepr emptyPR + + +{-# INLINE_PA replicatePA #-} +replicatePA :: PA a => Int -> a -> PData a +replicatePA n x + = fromArrPRepr + $ replicatePR n $ toPRepr x + + +{-# INLINE_PA replicatesPA #-} +replicatesPA :: PA a => U.Segd -> PData a -> PData a +replicatesPA segd xs + = fromArrPRepr + $ replicatesPR segd (toArrPRepr xs) + + +{-# INLINE_PA appendPA #-} +appendPA :: PA a => PData a -> PData a -> PData a +appendPA xs ys + = fromArrPRepr + $ appendPR (toArrPRepr xs) (toArrPRepr ys) + + +{-# INLINE_PA appendsPA #-} +appendsPA :: PA a => U.Segd -> U.Segd -> PData a -> U.Segd + -> PData a -> PData a +appendsPA segdResult segd1 xs segd2 ys + = fromArrPRepr + $ appendsPR segdResult segd1 (toArrPRepr xs) segd2 (toArrPRepr ys) + + +-- Projections ---------------------------------- +{-# INLINE_PA lengthPA #-} +lengthPA :: PA a => PData a -> Int +lengthPA xs + = lengthPR (toArrPRepr xs) + + +{-# INLINE_PA indexPA #-} +indexPA :: PA a => PData a -> Int -> a +indexPA xs i + = fromPRepr + $ indexPR (toArrPRepr xs) i + + +{-# INLINE_PA indexsPA #-} +indexsPA :: PA a => PDatas a -> U.Array (Int, Int) -> PData a +indexsPA pdatas srcixs + = fromArrPRepr + $ indexsPR (toArrPReprs pdatas) srcixs + + +{-# INLINE_PA indexvsPA #-} +indexvsPA :: PA a => PDatas a -> U.VSegd -> U.Array (Int, Int) -> PData a +indexvsPA pdatas vsegd srcixs + = fromArrPRepr + $ indexvsPR (toArrPReprs pdatas) vsegd srcixs + + +{-# INLINE_PDATA bpermutePA #-} +bpermutePA :: PA a => PData a -> U.Array Int -> PData a +bpermutePA xs ixs + = fromArrPRepr + $ bpermutePR (toArrPRepr xs) ixs + + +{-# INLINE_PA extractPA #-} +extractPA :: PA a => PData a -> Int -> Int -> PData a +extractPA xs start len + = fromArrPRepr + $ extractPR (toArrPRepr xs) start len + + +{-# INLINE_PA extractssPA #-} +extractssPA :: PA a => PDatas a -> U.SSegd -> PData a +extractssPA xss segd + = fromArrPRepr + $ extractssPR (toArrPReprs xss) segd + + +{-# INLINE_PA extractvsPA #-} +extractvsPA :: PA a => PDatas a -> U.VSegd -> PData a +extractvsPA xss segd + = fromArrPRepr + $ extractvsPR (toArrPReprs xss) segd + + +-- Pack and Combine ----------------------------- +{-# INLINE_PA packByTagPA #-} +packByTagPA :: PA a => PData a -> U.Array Tag -> Tag -> PData a +packByTagPA xs tags tag + = fromArrPRepr + $ packByTagPR (toArrPRepr xs) tags tag + + +{-# INLINE_PA combine2PA #-} +combine2PA :: PA a => U.Sel2 -> PData a -> PData a -> PData a +combine2PA sel xs ys + = fromArrPRepr + $ combine2PR sel (toArrPRepr xs) (toArrPRepr ys) + + +-- Conversions ---------------------------------- +{-# INLINE_PA fromVectorPA #-} +fromVectorPA :: PA a => Vector a -> PData a +fromVectorPA vec + = fromArrPRepr + $ fromVectorPR (V.map toPRepr vec) + + +{-# INLINE_PA toVectorPA #-} +toVectorPA :: PA a => PData a -> Vector a +toVectorPA pdata + = V.map fromPRepr + $ toVectorPR (toArrPRepr pdata) + + +{-# INLINE_PA emptydPA #-} +emptydPA :: PA a => PDatas a +emptydPA + = fromArrPReprs + $ emptydPR + + +{-# INLINE_PA singletondPA #-} +singletondPA :: PA a => PData a -> PDatas a +singletondPA pdata + = fromArrPReprs + $ singletondPR (toArrPRepr pdata) + + +{-# INLINE_PA lengthdPA #-} +lengthdPA :: PA a => PDatas a -> Int +lengthdPA pdatas + = lengthdPR (toArrPReprs pdatas) + + +{-# INLINE_PA indexdPA #-} +indexdPA :: PA a => PDatas a -> Int -> PData a +indexdPA pdatas ix + = fromArrPRepr + $ indexdPR (toArrPReprs pdatas) ix + + +{-# INLINE_PA appenddPA #-} +appenddPA :: PA a => PDatas a -> PDatas a -> PDatas a +appenddPA xs ys + = fromArrPReprs + $ appenddPR (toArrPReprs xs) (toArrPReprs ys) + + +{-# INLINE_PA fromVectordPA #-} +fromVectordPA :: PA a => V.Vector (PData a) -> PDatas a +fromVectordPA vec + = fromArrPReprs + $ fromVectordPR (V.map toArrPRepr vec) + + +{-# INLINE_PA toVectordPA #-} +toVectordPA :: PA a => PDatas a -> V.Vector (PData a) +toVectordPA pdatas + = V.map fromArrPRepr + $ toVectordPR (toArrPReprs pdatas) + diff --git a/Data/Array/Parallel/PArray/PRepr/Instances.hs b/Data/Array/Parallel/PArray/PRepr/Instances.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PRepr/Instances.hs @@ -0,0 +1,203 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP, UndecidableInstances #-} +#include "fusion-phases.h" + +-- | Simple instances for the PRRepr/PA family and class. +-- This module is kept separate from PRepr.Base to break an import cycle +-- between PRepr.Base PRepr.Instances and PArray.PData.Wrap +-- +module Data.Array.Parallel.PArray.PRepr.Instances where +import Data.Array.Parallel.PArray.Types +import Data.Array.Parallel.PArray.PRepr.Base +import Data.Array.Parallel.PArray.PData.Base + +import Data.Array.Parallel.PArray.PData.Void +import Data.Array.Parallel.PArray.PData.Sum2 +import Data.Array.Parallel.PArray.PData.Word8 +import Data.Array.Parallel.PArray.PData.Wrap () +import Data.Array.Parallel.PArray.PData.Unit () +import Data.Array.Parallel.PArray.PData.Nested () +import Data.Array.Parallel.PArray.PData.Tuple2 () +import Data.Array.Parallel.PArray.PData.Int () +import Data.Array.Parallel.PArray.PData.Double () +import qualified Data.Array.Parallel.Unlifted as U +import qualified Data.Vector as V +import Data.Word + + +-- Void ----------------------------------------------------------------------- +type instance PRepr Void = Void + +instance PA Void where + toPRepr = id + fromPRepr = id + toArrPRepr = id + fromArrPRepr = id + toArrPReprs = id + fromArrPReprs = id + + +-- Unit ----------------------------------------------------------------------- +type instance PRepr () = () + +instance PA () where + toPRepr = id + fromPRepr = id + toArrPRepr = id + fromArrPRepr = id + toArrPReprs = id + fromArrPReprs = id + + +-- Int ------------------------------------------------------------------------ +type instance PRepr Int = Int + +instance PA Int where + toPRepr = id + fromPRepr = id + toArrPRepr = id + fromArrPRepr = id + toArrPReprs = id + fromArrPReprs = id + + +-- Int ------------------------------------------------------------------------ +type instance PRepr Word8 = Word8 + +instance PA Word8 where + toPRepr = id + fromPRepr = id + toArrPRepr = id + fromArrPRepr = id + toArrPReprs = id + fromArrPReprs = id + + +-- Double --------------------------------------------------------------------- +type instance PRepr Double = Double + +instance PA Double where + toPRepr = id + fromPRepr = id + toArrPRepr = id + fromArrPRepr = id + toArrPReprs = id + fromArrPReprs = id + + +-- Bool ----------------------------------------------------------------------- +-- | We use the `Void` type for both sides because we only care about the tag. +-- The `Void` fields don't use any space at runtime. +type instance PRepr Bool + = Sum2 Void Void + +data instance PData Bool + = PBool U.Sel2 + +data instance PDatas Bool + = PBools (V.Vector U.Sel2) + +instance PA Bool where + {-# INLINE toPRepr #-} + toPRepr False = Alt2_1 void + toPRepr True = Alt2_2 void + + {-# INLINE fromPRepr #-} + fromPRepr (Alt2_1 _) = False + fromPRepr (Alt2_2 _) = True + + {-# INLINE toArrPRepr #-} + toArrPRepr (PBool sel) + = PSum2 sel pvoid pvoid + + {-# INLINE fromArrPRepr #-} + fromArrPRepr (PSum2 sel _ _) + = PBool sel + + {-# INLINE toArrPReprs #-} + toArrPReprs (PBools sels) + = PSum2s sels + (pvoids $ V.length sels) + (pvoids $ V.length sels) + + {-# INLINE fromArrPReprs #-} + fromArrPReprs (PSum2s sels _ _) + = PBools sels + + +-- Ordering ------------------------------------------------------------------- +type instance PRepr Ordering + = Word8 + +data instance PData Ordering + = POrdering (U.Array Word8) + +data instance PDatas Ordering + = POrderings (U.Arrays Word8) + +instance PA Ordering where + {-# INLINE toPRepr #-} + toPRepr LT = 0 + toPRepr EQ = 1 + toPRepr GT = 2 + + {-# INLINE fromPRepr #-} + fromPRepr 0 = LT + fromPRepr 1 = EQ + fromPRepr 2 = GT + fromPRepr _ = error "dph-prim-vseg: bad value converting Word8 to Ordering" + + {-# INLINE toArrPRepr #-} + toArrPRepr (POrdering arr) + = PWord8 arr + + {-# INLINE fromArrPRepr #-} + fromArrPRepr (PWord8 arr) + = POrdering arr + + {-# INLINE toArrPReprs #-} + toArrPReprs (POrderings arrs) + = PWord8s arrs + + {-# INLINE fromArrPReprs #-} + fromArrPReprs (PWord8s arrs) + = POrderings arrs + + +-- Either --------------------------------------------------------------------- +type instance PRepr (Either a b) + = Sum2 a b + +data instance PData (Either a b) + = PEither U.Sel2 (PData a) (PData b) + +data instance PDatas (Either a b) + = PEithers (V.Vector U.Sel2) (PDatas a) (PDatas b) + +instance (PR a, PR b) => PA (Either a b) where + {-# INLINE toPRepr #-} + toPRepr xx + = case xx of + Left x -> Alt2_1 x + Right y -> Alt2_2 y + + {-# INLINE fromPRepr #-} + fromPRepr (Alt2_1 x) = Left x + fromPRepr (Alt2_2 x) = Right x + + {-# INLINE toArrPRepr #-} + toArrPRepr (PEither sel pdata1 pdata2) + = PSum2 sel pdata1 pdata2 + + {-# INLINE fromArrPRepr #-} + fromArrPRepr (PSum2 sel pdata1 pdata2) + = PEither sel pdata1 pdata2 + + {-# INLINE toArrPReprs #-} + toArrPReprs (PEithers sels pdatas1 pdatas2) + = PSum2s sels pdatas1 pdatas2 + + {-# INLINE fromArrPReprs #-} + fromArrPReprs (PSum2s sels pdatas1 pdatas2) + = PEithers sels pdatas1 pdatas2 + diff --git a/Data/Array/Parallel/PArray/PRepr/Nested.hs b/Data/Array/Parallel/PArray/PRepr/Nested.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PRepr/Nested.hs @@ -0,0 +1,106 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | PRepr/PA instance for nested arrays, +-- and PA wrappers for other functions defined in D.A.P.PArray.PData.Nested. +module Data.Array.Parallel.PArray.PRepr.Nested + ( mkPNestedPA + , concatPA, concatlPA + , unconcatPA + , appendlPA + , indexlPA + , slicelPA) +where +import Data.Array.Parallel.PArray.PRepr.Base +import Data.Array.Parallel.PArray.PData.Base +import Data.Array.Parallel.PArray.PData.Nested +import qualified Data.Array.Parallel.Unlifted as U +import qualified Data.Vector as V + + +-- PArray --------------------------------------------------------------------- +type instance PRepr (PArray a) + = PArray (PRepr a) + +instance PA a => PA (PArray a) where + {-# INLINE_PA toPRepr #-} + toPRepr (PArray n xs) + = PArray n $ toArrPRepr xs + + {-# INLINE_PA fromPRepr #-} + fromPRepr (PArray n xs) + = PArray n $ fromArrPRepr xs + + {-# INLINE_PA toArrPRepr #-} + toArrPRepr (PNested vsegd xs segd flat) + = PNested vsegd (toArrPReprs xs) segd (toArrPRepr flat) + + {-# INLINE_PA fromArrPRepr #-} + fromArrPRepr (PNested vsegd xs segd flat) + = PNested vsegd (fromArrPReprs xs) segd (fromArrPRepr flat) + + {-# INLINE_PA toArrPReprs #-} + toArrPReprs (PNesteds vec) + = PNesteds $ V.map toArrPRepr vec + + {-# INLINE_PA fromArrPReprs #-} + fromArrPReprs (PNesteds vec) + = PNesteds $ V.map fromArrPRepr vec + + +-- PA Wrappers ---------------------------------------------------------------- +-- These wrappers have the same types in the ones in D.A.P.PArray.PData.Nested, +-- except that they take a PA dictionary instead of a PR dictionary. +-- +-- See D.A.P.PArray.PRepr.Base for docs on why we need the wrappers. +-- See D.A.P.PArray.PData.Nested for docs on what the PR versions do. +-- +-- | Conatruct a nested array. +mkPNestedPA + :: PA a + => U.VSegd -> PDatas a + -> U.Segd -> PData a + -> PData (PArray a) + +mkPNestedPA vsegd pdatas segd pdata + = let pdatas' = toArrPReprs pdatas + pdata' = toArrPRepr pdata + in fromArrPRepr $ mkPNested vsegd pdatas' segd pdata' + + +concatPA :: PA a => PData (PArray a) -> PData a +concatPA arr + = fromArrPRepr $ concatPR $ toArrPRepr arr +{-# INLINE_PA concatPA #-} + + +unconcatPA :: (PA a, PA b) => PData (PArray a) -> PData b -> PData (PArray b) +unconcatPA arr1 arr2 + = fromArrPRepr $ unconcatPR (toArrPRepr arr1) (toArrPRepr arr2) +{-# INLINE_PA unconcatPA #-} + + +concatlPA :: PA a => PData (PArray (PArray a)) -> PData (PArray a) +concatlPA arr + = fromArrPRepr $ concatlPR (toArrPRepr arr) +{-# INLINE_PA concatlPA #-} + + +appendlPA :: PA a => PData (PArray a) -> PData (PArray a) -> PData (PArray a) +appendlPA arr1 arr2 + = fromArrPRepr $ appendlPR (toArrPRepr arr1) (toArrPRepr arr2) +{-# INLINE_PA appendlPA #-} + + +indexlPA :: PA a => PData (PArray a) -> PData Int -> PData a +indexlPA arr ixs + = fromArrPRepr $ indexlPR (toArrPRepr arr) ixs +{-# INLINE_PA indexlPA #-} + + +slicelPA :: PA a => PData Int -> PData Int -> PData (PArray a) -> PData (PArray a) +slicelPA starts lens arr + = fromArrPRepr $ slicelPR starts lens (toArrPRepr arr) +{-# INLINE_PA slicelPA #-} + diff --git a/Data/Array/Parallel/PArray/PRepr/Tuple.hs b/Data/Array/Parallel/PArray/PRepr/Tuple.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/PRepr/Tuple.hs @@ -0,0 +1,156 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | PRepr instance for tuples +-- and PD wrappers for other functions defined in D.A.P.PArray.PData.Tuple. +module Data.Array.Parallel.PArray.PRepr.Tuple + ( PRepr + , ziplPA) +where +import Data.Array.Parallel.PArray.Types +import Data.Array.Parallel.PArray.PRepr.Base +import Data.Array.Parallel.PArray.PData.Base +import Data.Array.Parallel.PArray.PData.Tuple2 +import Data.Array.Parallel.PArray.PData.Tuple3 +import Data.Array.Parallel.PArray.PData.Tuple4 +import Data.Array.Parallel.PArray.PData.Tuple5 +import Data.Array.Parallel.PArray.PData.Nested +import Data.Array.Parallel.PArray.PData.Wrap + + +-- Tuple2 -------------------------------------------------------------------- +type instance PRepr (a, b) + = (Wrap a, Wrap b) + +instance (PA a, PA b) => PA (a, b) where + {-# INLINE_PA toPRepr #-} + toPRepr (a, b) + = (Wrap a, Wrap b) + + {-# INLINE_PA fromPRepr #-} + fromPRepr (Wrap a, Wrap b) + = (a, b) + + {-# INLINE_PA toArrPRepr #-} + toArrPRepr (PTuple2 as bs) + = PTuple2 (PWrap as) (PWrap bs) + + {-# INLINE_PA fromArrPRepr #-} + fromArrPRepr (PTuple2 (PWrap as) (PWrap bs)) + = PTuple2 as bs + + {-# INLINE_PA toArrPReprs #-} + toArrPReprs (PTuple2s as bs) + = PTuple2s (PWraps as) (PWraps bs) + + {-# INLINE_PA fromArrPReprs #-} + fromArrPReprs (PTuple2s (PWraps as) (PWraps bs)) + = PTuple2s as bs + + +-- | Lifted zip on PData arrays. +ziplPA :: (PA a, PA b) + => PData (PArray a) -> PData (PArray b) -> PData (PArray (a, b)) +ziplPA xs ys + = let + -- TODO: can we use the flat version here? + PNested vsegd (PTuple2s xs' ys') segd _ + = ziplPR (toNestedArrPRepr xs) (toNestedArrPRepr ys) + + pdatas = PTuple2s (fromArrPReprs xs') (fromArrPReprs ys') + flat = fromArrPRepr $ extractvs_delay (toArrPReprs pdatas) vsegd + + in PNested vsegd pdatas segd flat + + +-- Tuple3 -------------------------------------------------------------------- +type instance PRepr (a, b, c) + = (Wrap a, Wrap b, Wrap c) + +instance (PA a, PA b, PA c) => PA (a, b, c) where + {-# INLINE_PA toPRepr #-} + toPRepr (a, b, c) + = (Wrap a, Wrap b, Wrap c) + + {-# INLINE_PA fromPRepr #-} + fromPRepr (Wrap a, Wrap b, Wrap c) + = (a, b, c) + + {-# INLINE_PA toArrPRepr #-} + toArrPRepr (PTuple3 as bs cs) + = PTuple3 (PWrap as) (PWrap bs) (PWrap cs) + + {-# INLINE_PA fromArrPRepr #-} + fromArrPRepr (PTuple3 (PWrap as) (PWrap bs) (PWrap cs)) + = PTuple3 as bs cs + + {-# INLINE_PA toArrPReprs #-} + toArrPReprs (PTuple3s as bs cs) + = PTuple3s (PWraps as) (PWraps bs) (PWraps cs) + + {-# INLINE_PA fromArrPReprs #-} + fromArrPReprs (PTuple3s (PWraps as) (PWraps bs) (PWraps cs)) + = PTuple3s as bs cs + + +-- Tuple4 -------------------------------------------------------------------- +type instance PRepr (a, b, c, d) + = (Wrap a, Wrap b, Wrap c, Wrap d) + +instance (PA a, PA b, PA c, PA d) => PA (a, b, c, d) where + {-# INLINE_PA toPRepr #-} + toPRepr (a, b, c, d) + = (Wrap a, Wrap b, Wrap c, Wrap d) + + {-# INLINE_PA fromPRepr #-} + fromPRepr (Wrap a, Wrap b, Wrap c, Wrap d) + = (a, b, c, d) + + {-# INLINE_PA toArrPRepr #-} + toArrPRepr (PTuple4 as bs cs ds) + = PTuple4 (PWrap as) (PWrap bs) (PWrap cs) (PWrap ds) + + {-# INLINE_PA fromArrPRepr #-} + fromArrPRepr (PTuple4 (PWrap as) (PWrap bs) (PWrap cs) (PWrap ds)) + = PTuple4 as bs cs ds + + {-# INLINE_PA toArrPReprs #-} + toArrPReprs (PTuple4s as bs cs ds) + = PTuple4s (PWraps as) (PWraps bs) (PWraps cs) (PWraps ds) + + {-# INLINE_PA fromArrPReprs #-} + fromArrPReprs (PTuple4s (PWraps as) (PWraps bs) (PWraps cs) (PWraps ds)) + = PTuple4s as bs cs ds + + +-- Tuple4 -------------------------------------------------------------------- +type instance PRepr (a, b, c, d, e) + = (Wrap a, Wrap b, Wrap c, Wrap d, Wrap e) + +instance (PA a, PA b, PA c, PA d, PA e) => PA (a, b, c, d, e) where + {-# INLINE_PA toPRepr #-} + toPRepr (a, b, c, d, e) + = (Wrap a, Wrap b, Wrap c, Wrap d, Wrap e) + + {-# INLINE_PA fromPRepr #-} + fromPRepr (Wrap a, Wrap b, Wrap c, Wrap d, Wrap e) + = (a, b, c, d, e) + + {-# INLINE_PA toArrPRepr #-} + toArrPRepr (PTuple5 as bs cs ds es) + = PTuple5 (PWrap as) (PWrap bs) (PWrap cs) (PWrap ds) (PWrap es) + + {-# INLINE_PA fromArrPRepr #-} + fromArrPRepr (PTuple5 (PWrap as) (PWrap bs) (PWrap cs) (PWrap ds) (PWrap es)) + = PTuple5 as bs cs ds es + + {-# INLINE_PA toArrPReprs #-} + toArrPReprs (PTuple5s as bs cs ds es) + = PTuple5s (PWraps as) (PWraps bs) (PWraps cs) (PWraps ds) (PWraps es) + + {-# INLINE_PA fromArrPReprs #-} + fromArrPReprs (PTuple5s (PWraps as) (PWraps bs) (PWraps cs) (PWraps ds) (PWraps es)) + = PTuple5s as bs cs ds es + + diff --git a/Data/Array/Parallel/PArray/Scalar.hs b/Data/Array/Parallel/PArray/Scalar.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/PArray/Scalar.hs @@ -0,0 +1,313 @@ +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +{-# OPTIONS_GHC -fno-warn-unused-binds #-} + +-- | Functions that work on parallel arrays of scalar elements. +-- Unlike the functions defined in D.A.P.PArray, these only need +-- Scalar dictionaries, instead of PR or PA dictionaries. +-- +-- They are used when defining vectorised Prelude functions, +-- eg in D.A.P.Prelude.Int and D.A.P.Prelude.Double. +-- +-- The map and zipWith functions are also used by the vectoriser when +-- vectorising uses of scalar operators like (+). +-- +module Data.Array.Parallel.PArray.Scalar + ( Scalar(..) + + -- * Conversions + , toUArray, fromUArray + , fromUArray2 + + -- * Maps and Zips + , map + , zipWith + , zipWith3 + + -- * Folds + , fold, folds + , fold1, fold1s + , fold1Index, fold1sIndex + + -- * Enumerations + , enumFromTo, enumFromTol) +where +import Data.Array.Parallel.PArray.PData.Void +import Data.Array.Parallel.PArray.PData.Word8 +import Data.Array.Parallel.PArray.PData.Double +import Data.Array.Parallel.PArray.PData +import Data.Array.Parallel.PArray.PRepr +import Data.Array.Parallel.Base +import Data.Word +import GHC.Exts +import qualified Data.Array.Parallel.Unlifted as U +import Prelude hiding ( map, zipWith, zipWith3, enumFromTo) + + +-- | Class of Scalar data that can be converted to and from single unboxed +-- vectors. +class (PA a, U.Elt a) => Scalar a where + fromScalarPData :: PData a -> U.Array a + toScalarPData :: U.Array a -> PData a + + fromScalarPDatas :: PDatas a -> U.Arrays a + toScalarPDatas :: U.Arrays a -> PDatas a + + +-- Shorthands for the above methods used in this module only. +from :: Scalar a => PData a -> U.Array a +from = fromScalarPData + +to :: Scalar a => U.Array a -> PData a +to = toScalarPData + + +-- Instances -------------------------------------------------------------- +instance Scalar Bool where + {-# INLINE toScalarPData #-} + toScalarPData bs + = PBool (U.tagsToSel2 (U.map fromBool bs)) + + {-# INLINE fromScalarPData #-} + fromScalarPData (PBool sel) + = U.map toBool (U.tagsSel2 sel) + + -- NOTE: There is no Arrays instance for Bool, + -- but we don't need it yet because the PDatas Sel2s instance + -- just uses a boxed vector of Sel2s. + {-# NOINLINE fromScalarPDatas #-} + fromScalarPDatas _ + = error "Data.Array.Parallel.PArray.Lifted.Scalar: no Arrays instance for Bool." + + {-# NOINLINE toScalarPDatas #-} + toScalarPDatas _ + = error "Data.Array.Parallel.PArray.Lifted.Scalar: no Arrays instance for Bool." + +instance U.Elt Ordering + +instance Scalar Ordering where + {-# INLINE toScalarPData #-} + toScalarPData + = POrdering . U.map toPRepr + + {-# INLINE fromScalarPData #-} + fromScalarPData (POrdering w8s) + = U.map fromPRepr w8s + + -- FIXME: no idea whether these are used; should be possible to convert, though + {-# INLINE toScalarPDatas #-} + toScalarPDatas _ + = error "Data.Array.Parallel.PArray.Lifted.Scalar: no 'Arrays' instance for 'Ordering'." + + {-# INLINE fromScalarPDatas #-} + fromScalarPDatas _ + = error "Data.Array.Parallel.PArray.Lifted.Scalar: no 'Arrays' instance for 'Ordering'." + +-- FIXME: this is a fake instance to enable us to vectorise 'Num' +type instance PRepr Integer = Void +data instance PData Integer = PInteger +data instance PDatas Integer = PIntegers +instance PA Integer +instance U.Elt Integer +instance Scalar Integer where + toScalarPData = fakeScalarInteger + fromScalarPData = fakeScalarInteger + toScalarPDatas = fakeScalarInteger + fromScalarPDatas = fakeScalarInteger +fakeScalarInteger :: a +fakeScalarInteger = error "D.A.P.PArray.Scalar: fake instance 'Scalar Integer'" + +-- See Note: Seqs in fromScalar +instance Scalar Int where + fromScalarPData (PInt xs) = xs `seq` xs + fromScalarPDatas (PInts xss) = xss `seq` xss + toScalarPData = PInt + toScalarPDatas = PInts + +instance Scalar Word8 where + fromScalarPData (PWord8 xs) = xs `seq` xs + fromScalarPDatas (PWord8s xss) = xss `seq` xss + toScalarPData = PWord8 + toScalarPDatas = PWord8s + +instance Scalar Double where + fromScalarPData (PDouble xs) = xs `seq` xs + fromScalarPDatas (PDoubles xss) = xss `seq` xss + toScalarPData = PDouble + toScalarPDatas = PDoubles + + +-- [Note: Seqs in fromScalar] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- As we expect the result of fromScalarPData to always be demanded by the +-- consuming function, we seq on it to force the demand. This helps to avoid +-- fusion problems when GHC can't see that the consumer actually demands the +-- data. This shows up in SMVM where removing the `seq in the Doubles instance +-- prevents the fold_vs/promoteSegdToVSegd rule from firing. + +-- Conversions ---------------------------------------------------------------- +{-# INLINE_PA fromUArray #-} +fromUArray :: Scalar a => U.Array a -> PArray a +fromUArray uarr + = let !(I# n#) = U.length uarr + in PArray n# (toScalarPData uarr) + + +{-# INLINE_PA toUArray #-} +toUArray :: Scalar a => PArray a -> U.Array a +toUArray (PArray _ pdata) + = fromScalarPData pdata + + +-- Tuple Conversions ---------------------------------------------------------- +-- | Convert an U.Array of pairs to a PArray. +{-# INLINE fromUArray2 #-} +fromUArray2 + :: (Scalar a, Scalar b) + => U.Array (a, b) -> PArray (a, b) +fromUArray2 ps + = let !(I# n#) = U.length ps + (xs,ys) = U.unzip ps + in PArray n# (PTuple2 (toScalarPData xs) (toScalarPData ys)) + + +-- Maps and Zips -------------------------------------------------------------- +-- | Apply a worker function to every element of an array, yielding a new array. +{-# INLINE_PA map #-} +map :: (Scalar a, Scalar b) + => (a -> b) -> PArray a -> PArray b + +map f (PArray len xs) + = PArray len $ to $ U.map f (from xs) + + +-- | Zip two arrays, yielding a new array. +{-# INLINE_PA zipWith #-} +zipWith :: (Scalar a, Scalar b, Scalar c) + => (a -> b -> c) -> PArray a -> PArray b -> PArray c + +zipWith f (PArray len xs) (PArray _ ys) + = PArray len $ to $ U.zipWith f (from xs) (from ys) + + +-- | Zip three arrays, yielding a new array. +{-# INLINE_PA zipWith3 #-} +zipWith3 + :: (Scalar a, Scalar b, Scalar c, Scalar d) + => (a -> b -> c -> d) -> PArray a -> PArray b -> PArray c -> PArray d + +zipWith3 f (PArray len xs) (PArray _ ys) (PArray _ zs) + = PArray len $ to $ U.zipWith3 f (from xs) (from ys) (from zs) + + +-- Folds ---------------------------------------------------------------------- +-- | Left fold over an array. +{-# INLINE_PA fold #-} +fold :: Scalar a + => (a -> a -> a) -> a -> PArray a -> a + +fold f !z (PArray _ pdata) + = U.fold f z $ from pdata + + +-- | Left fold over an array, using the first element to initialise the state. +{-# INLINE_PA fold1 #-} +fold1 :: Scalar a + => (a -> a -> a) -> PArray a -> a + +fold1 f (PArray _ pdata) + = U.fold1 f $ from pdata + + +-- | Segmented fold of an array of arrays. +folds :: (Scalar a, U.Elts a) + => (a -> a -> a) -> a -> PArray (PArray a) -> PArray a + +folds f !z (PArray _ (PNested vsegd pdatas _ _)) + = pdatas `seq` -- Don't seq on vsegd. See Note: fold/promoteSegd + fromUArray $ U.fold_vs f z vsegd $ fromScalarPDatas pdatas +{-# INLINE_PA folds #-} + + +-- | Segmented fold of an array of arrays, using the first element of each +-- segment to initialse the state for that segment. +fold1s :: (Scalar a, U.Elts a) + => (a -> a -> a) -> PArray (PArray a) -> PArray a + +fold1s f (PArray _ (PNested vsegd pdatas _ _)) + = pdatas `seq` -- Don't seq on vsegd. See Note: fold/promoteSegd + fromUArray $ U.fold1_vs f vsegd $ fromScalarPDatas pdatas +{-# INLINE_PA fold1s #-} + + +-- | Left fold over an array, also passing the index of each element +-- to the parameter function. +fold1Index + :: Scalar a + => ((Int, a) -> (Int, a) -> (Int, a)) -> PArray a -> Int + +fold1Index f + = fst . U.fold1 f . U.indexed . toUArray +{-# INLINE_PA fold1Index #-} + + +-- | Segmented fold over an array, also passing the index of each +-- element to the parameter function. +-- TODO: fold the psegs then replicate, like in the other folds. +-- this currently has the wrong complexity. +fold1sIndex + :: Scalar a + => ((Int, a) -> (Int, a) -> (Int, a)) + -> PArray (PArray a) -> PArray Int + +{-# INLINE_PA fold1sIndex #-} +fold1sIndex f (PArray n# pdata) + = let segd = takeSegdPD pdata + xs = concatPA pdata + in PArray n# + $ toScalarPData + $ U.fsts + $ U.fold1_s f segd + $ U.zip (U.indices_s segd) + $ fromScalarPData xs + +{- [Note: fold/promoteSegd] + ~~~~~~~~~~~~~~~~~~~~~~~~ + In the segmented fold functions above, don't seq on the vsegd because we + we need the vsegd to remain as an argument to the fold function. + This ensures that the fold/promoteSegdToVSegd rules from DPH_Interface.h + will fire, which shows up in SMVM. +-} + +-- Enumerations -------------------------------------------------------------- +-- | Construct a range of integers. +{-# INLINE_PA enumFromTo #-} +enumFromTo :: Int -> Int -> PArray Int +enumFromTo m n + = fromUArray (U.enumFromTo m n) + + +{-# INLINE_PA enumFromTol #-} +enumFromTol :: PArray Int -> PArray Int -> PArray (PArray Int) +enumFromTol (PArray m# ms) (PArray _ ns) + = let + lens = U.zipWith distance (fromScalarPData ms) (fromScalarPData ns) + segd = U.lengthsToSegd lens + + flat = toScalarPData + $ U.enumFromStepLenEach + (U.elementsSegd segd) + (fromScalarPData ms) + (U.replicate (U.elementsSegd segd) 1) + lens + + vsegd = U.promoteSegdToVSegd segd + pdatas = singletondPA flat + + in PArray m# $ PNested vsegd pdatas segd flat + +distance :: Int -> Int -> Int +{-# INLINE_STREAM distance #-} +distance m n = max 0 (n - m + 1) + diff --git a/Data/Array/Parallel/Prelude.hs b/Data/Array/Parallel/Prelude.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/Prelude.hs @@ -0,0 +1,17 @@ +-- |This modules bundles all vectorised versions of Prelude definitions. +-- +-- /This module should not be explicitly imported in user code anymore./ +-- User code should only import 'Data.Array.Parallel' and, until the +-- vectoriser supports type classes, the type-specific +-- modules 'Data.Array.Parallel.Prelude.*'. + +module Data.Array.Parallel.Prelude + ( module Data.Array.Parallel.Prelude.Base + , module Data.Array.Parallel.Prelude.Bool) +where +import Data.Array.Parallel.Prelude.Base +import Data.Array.Parallel.Prelude.Bool +import Data.Array.Parallel.Prelude.Ordering () +import Data.Array.Parallel.Prelude.Int () +import Data.Array.Parallel.Prelude.Word8 () +import Data.Array.Parallel.Prelude.Double () diff --git a/Data/Array/Parallel/Prelude/Base.hs b/Data/Array/Parallel/Prelude/Base.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/Prelude/Base.hs @@ -0,0 +1,46 @@ +{-# OPTIONS_GHC -fvectorise #-} + +-- |This module sets up the basic vectorisation map for vectorising the DPH Prelude. +module Data.Array.Parallel.Prelude.Base + ( PArr + -- , () + , Bool(..) + , Ordering(..) + , Word8, Int + , Float, Double + , Eq(..), Ord(..) + , Show + , Num(..) + ) +where +import Data.Array.Parallel.Prim () -- dependency required by the vectoriser + +import Data.Array.Parallel.PArr +import Data.Array.Parallel.PArray.PData.Base +import Data.Array.Parallel.Lifted.Closure + +import Data.Word (Word8) + + +-- internal types +{-# VECTORISE SCALAR type PArr = PArray #-} +{-# VECTORISE SCALAR type PArray = PArray #-} +{-# VECTORISE SCALAR type (->) = (:->) #-} + +-- vectorised versions of types from the standard Prelude +{-# VECTORISE type () = () #-} +{-# VECTORISE type Bool = Bool #-} +{-# VECTORISE type Ordering = Ordering #-} +{-# VECTORISE SCALAR type Word8 #-} +{-# VECTORISE SCALAR type Int #-} +{-# VECTORISE SCALAR type Float #-} +{-# VECTORISE SCALAR type Double #-} + +-- FIXME: currently a fake definition to allow 'Integer' in SCALAR class instances +{-# VECTORISE SCALAR type Integer #-} + +-- vectorised versions of type classes from the standard Prelude +{-# VECTORISE class Eq #-} +{-# VECTORISE class Ord #-} +{-# VECTORISE class Show #-} -- only to facilitate 'Num', no vectorised instances provided +{-# VECTORISE class Num #-} diff --git a/Data/Array/Parallel/Prelude/Bool.hs b/Data/Array/Parallel/Prelude/Bool.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/Prelude/Bool.hs @@ -0,0 +1,135 @@ +{-# OPTIONS_GHC -fvectorise #-} + +module Data.Array.Parallel.Prelude.Bool + ( Bool(..) + , P.otherwise + , (P.&&), (P.||), P.not, andP, orP + , fromBool, toBool) +where +-- Primitives needed by the vectoriser. +import Data.Array.Parallel.Prim +import Data.Array.Parallel.PArr +import Data.Array.Parallel.Prelude.Base (Bool(..), Int, Eq, Ord) +import Data.Array.Parallel.Prelude.Int as I (sumP, (==), (/=)) -- just temporary +import Data.Array.Parallel.Lifted (mapPP, lengthPP) -- just temporary +import Data.Array.Parallel.PArray.PRepr +import Data.Array.Parallel.PArray.PData.Base +import qualified Data.Array.Parallel.Unlifted as U +import Data.Bits +import qualified Prelude as P + + +-- instances of standard type classes from the Prelude +{-# VECTORISE SCALAR instance Eq Bool #-} +{-# VECTORISE SCALAR instance Ord Bool #-} + +-- and ------------------------------------------------------------------------ +{-# VECTORISE (P.&&) = (&&*) #-} + +(&&*) :: Bool :-> Bool :-> Bool +(&&*) = closure2 (P.&&) and_l +{-# INLINE (&&*) #-} +{-# NOVECTORISE (&&*) #-} + +and_l :: PArray Bool -> PArray Bool -> PArray Bool +and_l (PArray n# bs) (PArray _ cs) + = PArray n# P.$ + case bs of { PBool sel1 -> + case cs of { PBool sel2 -> + PBool P.$ U.tagsToSel2 (U.zipWith (.&.) (U.tagsSel2 sel1) (U.tagsSel2 sel2)) }} +{-# INLINE and_l #-} +{-# NOVECTORISE and_l #-} + + +-- or ------------------------------------------------------------------------- +{-# VECTORISE (P.||) = (||*) #-} + +(||*) :: Bool :-> Bool :-> Bool +(||*) = closure2 (P.||) or_l +{-# INLINE (||*) #-} +{-# NOVECTORISE (||*) #-} + +or_l :: PArray Bool -> PArray Bool -> PArray Bool +or_l (PArray n# bs) (PArray _ cs) + = PArray n# P.$ + case bs of { PBool sel1 -> + case cs of { PBool sel2 -> + PBool P.$ U.tagsToSel2 (U.zipWith (.|.) (U.tagsSel2 sel1) (U.tagsSel2 sel2)) }} +{-# INLINE or_l #-} +{-# NOVECTORISE or_l #-} + + +-- not ------------------------------------------------------------------------ +{-# VECTORISE P.not = notPP #-} + +notPP :: Bool :-> Bool +notPP = closure1 P.not notPP_l +{-# INLINE notPP #-} +{-# NOVECTORISE notPP #-} + +notPP_l :: PArray Bool -> PArray Bool +notPP_l (PArray n# bs) + = PArray n# P.$ + case bs of { PBool sel -> + PBool P.$ U.tagsToSel2 (U.map complement (U.tagsSel2 sel)) } +{-# NOVECTORISE notPP_l #-} +{-# INLINE notPP_l #-} + + +{- TODO: We can't do these because there is no Unboxes instance for Bool. +-- andP ----------------------------------------------------------------------- +andP :: PArr Bool -> Bool +andP _ = True +{-# NOINLINE andP #-} +{-# VECTORISE andP = andPP #-} + +andPP :: PArray Bool :-> Bool +andPP = L.closure1' (SC.fold (&&) True) (SC.folds (&&) True) +{-# INLINE andPP #-} +{-# NOVECTORISE andPP #-} + + +-- orP ------------------------------------------------------------------------ +orP :: PArr Bool -> Bool +orP _ = True +{-# NOINLINE orP #-} +{-# VECTORISE orP = orPP #-} + +orPP :: PArray Bool :-> Bool +orPP = L.closure1' (SC.fold (||) False) (SC.folds (||) False) +{-# INLINE orPP #-} +{-# NOVECTORISE orPP #-} +-} + +-- Until we have Unboxes for Bool, we use the following definitions instead. + +andP :: PArr Bool -> Bool +andP bs = I.sumP (mapP fromBool bs) I.== lengthP bs + +orP :: PArr Bool -> Bool +orP bs = sumP (mapP fromBool bs) I./= 0 + +-- Defining 'mapP' and 'lengthP' here is just a kludge until the original definitions of +-- 'andP' and 'orP' work again. +mapP :: (a -> b) -> PArr a -> PArr b +mapP !_ !_ = emptyPArr +{-# NOINLINE mapP #-} +{-# VECTORISE mapP = mapPP #-} + +lengthP :: PArr a -> Int +lengthP = lengthPArr +{-# NOINLINE lengthP #-} +{-# VECTORISE lengthP = lengthPP #-} + + +-- conversion functions -------------------------------------------------------- + +fromBool :: Bool -> Int +fromBool False = 0 +fromBool True = 1 +{-# VECTORISE SCALAR fromBool #-} + +toBool :: Int -> Bool +toBool 0 = False +toBool _ = True +{-# VECTORISE SCALAR toBool #-} diff --git a/Data/Array/Parallel/Prelude/Double.hs b/Data/Array/Parallel/Prelude/Double.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/Prelude/Double.hs @@ -0,0 +1,256 @@ +{-# OPTIONS_GHC -fvectorise #-} + +module Data.Array.Parallel.Prelude.Double + ( Double + + -- * Ord + , (==), (/=), (<), (<=), (>), (>=), min, max + , maximumP, minimumP + , maxIndexP, minIndexP + + -- * Num + , (+), (-), (*), (/) + , negate, abs + , sumP, productP + + -- * Floating + , pi + , sqrt + , exp, (**) + , log, logBase + , sin, tan, cos + , asin, atan, acos + , sinh, tanh, cosh + , asinh, atanh, acosh + + -- * RealFrac + , fromInt) +where +-- Primitives needed by the vectoriser. +import Data.Array.Parallel.Prim () +import Data.Array.Parallel.Prelude.Base (Bool, Int, Double, Eq, Ord, Num) +import Data.Array.Parallel.PArr +import Data.Array.Parallel.PArray +import Data.Array.Parallel.Lifted ((:->)(..)) +import qualified Data.Array.Parallel.Lifted as L +import qualified Data.Array.Parallel.PArray.Scalar as SC +import qualified Prelude as P + + +{-# VECTORISE SCALAR instance Eq Double #-} +{-# VECTORISE SCALAR instance Ord Double #-} +{-# VECTORISE SCALAR instance Num Double #-} + + +infixl 7 *, / +infixl 6 +, - +infix 4 ==, /=, <, <=, >, >= + +-- Ord ------------------------------------------------------------------------ +(==), (/=), (<), (<=), (>), (>=) :: Double -> Double -> Bool + +(==) = (P.==) +{-# VECTORISE SCALAR (==) #-} + +(/=) = (P./=) +{-# VECTORISE SCALAR (/=) #-} + +(<=) = (P.<=) +{-# VECTORISE SCALAR (<=) #-} + +(<) = (P.<) +{-# VECTORISE SCALAR (<) #-} + +(>=) = (P.>=) +{-# VECTORISE SCALAR (>=) #-} + +(>) = (P.>) +{-# VECTORISE SCALAR (>) #-} + + +-- min/max ---------------------------- +min, max :: Double -> Double -> Double + +min = P.min +{-# VECTORISE SCALAR min #-} + +max = P.max +{-# VECTORISE SCALAR max #-} + + +-- minimum/maximum -------------------- +minimumP, maximumP :: PArr Double -> Double + +minimumP arr = headPArr arr +{-# NOINLINE minimumP #-} +{-# VECTORISE minimumP = minimumPP #-} + +maximumP arr = headPArr arr +{-# NOINLINE maximumP #-} +{-# VECTORISE maximumP = maximumPP #-} + +minimumPP, maximumPP :: PArray Double :-> Double +minimumPP = L.closure1' (SC.fold1 P.min) (SC.fold1s P.min) +{-# INLINE minimumPP #-} +{-# NOVECTORISE minimumPP #-} + +maximumPP = L.closure1' (SC.fold1 P.max) (SC.fold1s P.max) +{-# INLINE maximumPP #-} +{-# NOVECTORISE maximumPP #-} + + +-- minIndex/maxIndex ------------------ +minIndexP :: PArr Double -> Int +minIndexP !_ = 0 +{-# NOINLINE minIndexP #-} +{-# VECTORISE minIndexP = minIndexPP #-} + +minIndexPP :: PArray Double :-> Int +minIndexPP = L.closure1' (SC.fold1Index min') (SC.fold1sIndex min') +{-# INLINE minIndexPP #-} +{-# NOVECTORISE minIndexPP #-} + +min' :: P.Ord b => (a, b) -> (a, b) -> (a, b) +min' (i,x) (j,y) | x P.<= y = (i,x) + | P.otherwise = (j,y) +{-# NOVECTORISE min' #-} + + +maxIndexP :: PArr Double -> Int +maxIndexP _ = 0 +{-# NOINLINE maxIndexP #-} +{-# VECTORISE maxIndexP = maxIndexPP #-} + +maxIndexPP :: PArray Double :-> Int +maxIndexPP = L.closure1' (SC.fold1Index max') (SC.fold1sIndex max') +{-# INLINE maxIndexPP #-} +{-# NOVECTORISE maxIndexPP #-} + +max' :: P.Ord b => (a, b) -> (a, b) -> (a, b) +max' (i,x) (j,y) | x P.>= y = (i,x) + | P.otherwise = (j,y) +{-# NOVECTORISE max' #-} + + +-- Num --------------------------------------------------------------------- +(+), (-), (*), (/) :: Double -> Double -> Double + +(+) = (P.+) +{-# VECTORISE SCALAR (+) #-} + +(-) = (P.-) +{-# VECTORISE SCALAR (-) #-} + +(*) = (P.*) +{-# VECTORISE (*) = mulPP #-} + +mulPP :: Double :-> Double :-> Double +mulPP = L.closure2' (P.*) (SC.zipWith (P.*)) +{-# INLINE mulPP #-} +{-# NOVECTORISE mulPP #-} + + +(/) = (P./) +{-# VECTORISE SCALAR (/) #-} + +-- negate/abs ------------------------- +negate, abs :: Double -> Double + +negate = P.negate +{-# VECTORISE SCALAR negate #-} + +abs = P.abs +{-# VECTORISE SCALAR abs #-} + + +-- sum/product ------------------------ +sumP, productP :: PArr Double -> Double + +sumP arr = headPArr arr +{-# NOINLINE sumP #-} +{-# VECTORISE sumP = sumPP #-} + +productP arr = headPArr arr +{-# NOINLINE productP #-} +{-# VECTORISE productP = productPP #-} + +sumPP, productPP :: PArray Double :-> Double +sumPP = L.closure1' (SC.fold (+) 0) (SC.folds (+) 0) +{-# INLINE sumPP #-} +{-# NOVECTORISE sumPP #-} + +productPP = L.closure1' (SC.fold (*) 1) (SC.folds (*) 1) +{-# INLINE productPP #-} +{-# NOVECTORISE productPP #-} + + +-- Floating ------------------------------------------------------------------- +pi :: Double +pi = P.pi +{-# NOVECTORISE pi #-} + +sqrt, exp, log, + sin, tan, cos, + asin, atan, acos, + sinh, tanh, cosh, + asinh, atanh, acosh :: Double -> Double + +exp = P.exp +{-# VECTORISE SCALAR exp #-} + +sqrt = P.sqrt +{-# VECTORISE SCALAR sqrt #-} + +log = P.log +{-# VECTORISE SCALAR log #-} + +sin = P.sin +{-# VECTORISE SCALAR sin #-} + +tan = P.tan +{-# VECTORISE SCALAR tan #-} + +cos = P.cos +{-# VECTORISE SCALAR cos #-} + +asin = P.asin +{-# VECTORISE SCALAR asin #-} + +atan = P.atan +{-# VECTORISE SCALAR atan #-} + +acos = P.acos +{-# VECTORISE SCALAR acos #-} + +sinh = P.sinh +{-# VECTORISE SCALAR sinh #-} + +tanh = P.tanh +{-# VECTORISE SCALAR tanh #-} + +cosh = P.cosh +{-# VECTORISE SCALAR cosh #-} + +asinh = P.asinh +{-# VECTORISE SCALAR asinh #-} + +atanh = P.atanh +{-# VECTORISE SCALAR atanh #-} + +acosh = P.acosh +{-# VECTORISE SCALAR acosh #-} + + +(**), logBase :: Double -> Double -> Double + +(**) = (P.**) +{-# VECTORISE SCALAR (**) #-} + +logBase = P.logBase +{-# VECTORISE SCALAR logBase #-} + + +-- RealFrac ------------------------------------------------------------------- +fromInt :: Int -> Double +fromInt = P.fromIntegral +{-# VECTORISE SCALAR fromInt #-} diff --git a/Data/Array/Parallel/Prelude/Int.hs b/Data/Array/Parallel/Prelude/Int.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/Prelude/Int.hs @@ -0,0 +1,197 @@ +{-# OPTIONS_GHC -fvectorise #-} + +module Data.Array.Parallel.Prelude.Int + ( Int + + -- * Ord + , (==), (/=), (<), (<=), (>), (>=), min, max + , maximumP, minimumP + , maxIndexP, minIndexP + + -- * Num + , (+), (-), (*) + , negate, abs + , sumP, productP + + -- * Integral + , div, mod, sqrt + + -- * Enum + , enumFromToP) +where +-- Primitives needed by the vectoriser. +import Data.Array.Parallel.Prim () +import Data.Array.Parallel.Prelude.Base (Bool, Int, Eq, Ord, Num) +import Data.Array.Parallel.PArr +import Data.Array.Parallel.PArray +import Data.Array.Parallel.Lifted ((:->)(..)) +import qualified Data.Array.Parallel.Lifted as L +import qualified Data.Array.Parallel.PArray.Scalar as SC +import qualified Prelude as P + + +{-# VECTORISE SCALAR instance Eq Int #-} +{-# VECTORISE SCALAR instance Ord Int #-} +{-# VECTORISE SCALAR instance Num Int #-} + + +infixl 7 * +infixl 6 +, - +infix 4 ==, /=, <, <=, >, >= +infixl 7 `div`, `mod` + +-- Ord ------------------------------------------------------------------------ +(==), (/=), (<), (<=), (>), (>=) :: Int -> Int -> Bool + +(==) = (P.==) +{-# VECTORISE SCALAR (==) #-} + +(/=) = (P./=) +{-# VECTORISE SCALAR (/=) #-} + +(<=) = (P.<=) +{-# VECTORISE SCALAR (<=) #-} + +(<) = (P.<) +{-# VECTORISE SCALAR (<) #-} + +(>=) = (P.>=) +{-# VECTORISE SCALAR (>=) #-} + +(>) = (P.>) +{-# VECTORISE SCALAR (>) #-} + + +-- min/max ---------------------------- +min, max :: Int -> Int -> Int + +min = P.min +{-# VECTORISE SCALAR min #-} + +max = P.max +{-# VECTORISE SCALAR max #-} + + +-- minimum/maximum -------------------- +minimumP, maximumP :: PArr Int -> Int + +minimumP arr = headPArr arr +{-# NOINLINE minimumP #-} +{-# VECTORISE minimumP = minimumPP #-} + +maximumP arr = headPArr arr +{-# NOINLINE maximumP #-} +{-# VECTORISE maximumP = maximumPP #-} + +minimumPP, maximumPP :: PArray Int :-> Int +minimumPP = L.closure1' (SC.fold1 P.min) (SC.fold1s P.min) +{-# INLINE minimumPP #-} +{-# NOVECTORISE minimumPP #-} + +maximumPP = L.closure1' (SC.fold1 P.max) (SC.fold1s P.max) +{-# INLINE maximumPP #-} +{-# NOVECTORISE maximumPP #-} + + +-- minIndex/maxIndex ------------------ +minIndexP :: PArr Int -> Int +minIndexP !_ = 0 +{-# NOINLINE minIndexP #-} +{-# VECTORISE minIndexP = minIndexPP #-} + +minIndexPP :: PArray Int :-> Int +minIndexPP = L.closure1' (SC.fold1Index min') (SC.fold1sIndex min') +{-# INLINE minIndexPP #-} +{-# NOVECTORISE minIndexPP #-} + +min' :: P.Ord b => (a, b) -> (a, b) -> (a, b) +min' (i,x) (j,y) | x P.<= y = (i,x) + | P.otherwise = (j,y) +{-# NOVECTORISE min' #-} + + +maxIndexP :: PArr Int -> Int +maxIndexP _ = 0 +{-# NOINLINE maxIndexP #-} +{-# VECTORISE maxIndexP = maxIndexPP #-} + +maxIndexPP :: PArray Int :-> Int +maxIndexPP = L.closure1' (SC.fold1Index max') (SC.fold1sIndex max') +{-# INLINE maxIndexPP #-} +{-# NOVECTORISE maxIndexPP #-} + +max' :: P.Ord b => (a, b) -> (a, b) -> (a, b) +max' (i,x) (j,y) | x P.>= y = (i,x) + | P.otherwise = (j,y) +{-# NOVECTORISE max' #-} + + +-- Num ------------------------------------------------------------------------ +(+), (-), (*) :: Int -> Int -> Int + +(+) = (P.+) +{-# VECTORISE SCALAR (+) #-} + +(-) = (P.-) +{-# VECTORISE SCALAR (-) #-} + +(*) = (P.*) +{-# VECTORISE SCALAR (*) #-} + + +-- negate/abs ------------------------- +negate, abs :: Int -> Int + +negate = P.negate +{-# VECTORISE SCALAR negate #-} + +abs = P.abs +{-# VECTORISE SCALAR abs #-} + + +-- sum/product ------------------------ +sumP, productP :: PArr Int -> Int + +sumP arr = headPArr arr +{-# NOINLINE sumP #-} +{-# VECTORISE sumP = sumPP #-} + +productP arr = headPArr arr +{-# NOINLINE productP #-} +{-# VECTORISE productP = productPP #-} + +sumPP, productPP :: PArray Int :-> Int +sumPP = L.closure1' (SC.fold (+) 0) (SC.folds (+) 0) +{-# INLINE sumPP #-} +{-# NOVECTORISE sumPP #-} + +productPP = L.closure1' (SC.fold (*) 1) (SC.folds (*) 1) +{-# INLINE productPP #-} +{-# NOVECTORISE productPP #-} + + +-- Integral ------------------------------------------------------------------- +div, mod :: Int -> Int -> Int + +div = P.div +{-# VECTORISE SCALAR div #-} + +mod = P.mod +{-# VECTORISE SCALAR mod #-} + + +sqrt :: Int -> Int +sqrt n = P.floor (P.sqrt (P.fromIntegral n) :: P.Double) +{-# VECTORISE SCALAR sqrt #-} + + +-- Enum ----------------------------------------------------------------------- +enumFromToP :: Int -> Int -> PArr Int +enumFromToP !_ !_ = emptyPArr +{-# NOINLINE enumFromToP #-} +{-# VECTORISE enumFromToP = enumFromToPP #-} + +enumFromToPP :: Int :-> Int :-> PArray Int +enumFromToPP = L.closure2' SC.enumFromTo SC.enumFromTol +{-# INLINE enumFromToPP #-} +{-# NOVECTORISE enumFromToPP #-} diff --git a/Data/Array/Parallel/Prelude/Ordering.hs b/Data/Array/Parallel/Prelude/Ordering.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/Prelude/Ordering.hs @@ -0,0 +1,55 @@ +{-# OPTIONS_GHC -fvectorise #-} + +module Data.Array.Parallel.Prelude.Ordering + ( Ordering + , isLT, isEQ, isGT) +where +import Data.Array.Parallel.Prim () +import Data.Array.Parallel.Prelude.Base () +import Data.Array.Parallel.PArray.PData +import Data.Array.Parallel.PArray.PData.Word8 +import Data.Array.Parallel.PArray.PRepr +import Data.Array.Parallel.Lifted ((:->)(..)) +import qualified Data.Array.Parallel.Lifted as L +import qualified Data.Array.Parallel.PArray.Scalar as SC + + +{-# VECTORISE SCALAR instance Eq Ordering #-} +{-# VECTORISE SCALAR instance Ord Ordering #-} + + +isLT, isEQ, isGT :: Ordering -> Bool + +isLT _ = False +{-# NOINLINE isLT #-} +{-# VECTORISE isLT = isLtPP #-} + +isEQ _ = False +{-# NOINLINE isEQ #-} +{-# VECTORISE isEQ = isEqPP #-} + +isGT _ = False +{-# NOINLINE isGT #-} +{-# VECTORISE isGT = isGtPP #-} + + +isLtPP, isEqPP, isGtPP :: Ordering :-> Bool +isLtPP = L.closure1' (== LT) (isOrdering LT) +{-# INLINE isLtPP #-} +{-# NOVECTORISE isLtPP #-} + +isEqPP = L.closure1' (== EQ) (isOrdering EQ) +{-# INLINE isEqPP #-} +{-# NOVECTORISE isEqPP #-} + +isGtPP = L.closure1' (== GT) (isOrdering GT) +{-# INLINE isGtPP #-} +{-# NOVECTORISE isGtPP #-} + +isOrdering :: Ordering -> PArray Ordering -> PArray Bool +isOrdering o (PArray n pdata) + = case pdata of + POrdering w8s + -> SC.map (== (toPRepr o)) (PArray n $ PWord8 w8s) +{-# INLINE isOrdering #-} +{-# NOVECTORISE isOrdering #-} diff --git a/Data/Array/Parallel/Prelude/Tuple.hs b/Data/Array/Parallel/Prelude/Tuple.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/Prelude/Tuple.hs @@ -0,0 +1,32 @@ + +-- | Closure converted tuple data constructors used by the vectoriser. +module Data.Array.Parallel.Prelude.Tuple + (tup2, tup3, tup4, tup5) +where +import Data.Array.Parallel.Lifted.Closure +import Data.Array.Parallel.PArray.PRepr +import qualified Data.Array.Parallel.PArray as PA + + +tup2 :: (PA a, PA b) + => a :-> b :-> (a, b) +tup2 = closure2' (,) PA.zip +{-# INLINE tup2 #-} + + +tup3 :: (PA a, PA b, PA c) + => a :-> b :-> c :-> (a, b, c) +tup3 = closure3' (,,) PA.zip3 +{-# INLINE tup3 #-} + + +tup4 :: (PA a, PA b, PA c, PA d) + => a :-> b :-> c :-> d :-> (a, b, c, d) +tup4 = closure4' (,,,) PA.zip4 +{-# INLINE tup4 #-} + + +tup5 :: (PA a, PA b, PA c, PA d) + => a :-> b :-> c :-> d :-> e :-> (a, b, c, d, e) +tup5 = closure5' (,,,,) PA.zip5 +{-# INLINE tup5 #-} diff --git a/Data/Array/Parallel/Prelude/Word8.hs b/Data/Array/Parallel/Prelude/Word8.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/Prelude/Word8.hs @@ -0,0 +1,195 @@ +{-# OPTIONS_GHC -fvectorise #-} + +module Data.Array.Parallel.Prelude.Word8 + ( Word8 + + -- * Ord + , (==), (/=), (<), (<=), (>), (>=), min, max + , maximumP, minimumP + , maxIndexP, minIndexP + + -- * Num + , (+), (-), (*) + , negate, abs + , sumP, productP + + -- * Integral + , div, mod, sqrt + + -- * Conversion + , fromInt + , toInt) +where +import Data.Array.Parallel.Prim () +import Data.Array.Parallel.Prelude.Base (Bool, Int, Word8, Eq, Ord, Num) +import Data.Array.Parallel.PArr +import Data.Array.Parallel.PArray +import Data.Array.Parallel.Lifted ((:->)(..)) +import qualified Data.Array.Parallel.Lifted as L +import qualified Data.Array.Parallel.PArray.Scalar as SC +import qualified Prelude as P + + +{-# VECTORISE SCALAR instance Eq Word8 #-} +{-# VECTORISE SCALAR instance Ord Word8 #-} +{-# VECTORISE SCALAR instance Num Word8 #-} + + +infixl 7 * +infixl 6 +, - +infix 4 ==, /=, <, <=, >, >= +infixl 7 `div`, `mod` + +-- Ord ------------------------------------------------------------------------ +(==), (/=), (<), (<=), (>), (>=) :: Word8 -> Word8 -> Bool + +(==) = (P.==) +{-# VECTORISE SCALAR (==) #-} + +(/=) = (P./=) +{-# VECTORISE SCALAR (/=) #-} + +(<=) = (P.<=) +{-# VECTORISE SCALAR (<=) #-} + +(<) = (P.<) +{-# VECTORISE SCALAR (<) #-} + +(>=) = (P.>=) +{-# VECTORISE SCALAR (>=) #-} + +(>) = (P.>) +{-# VECTORISE SCALAR (>) #-} + + +-- min/max ---------------------------- +min, max :: Word8 -> Word8 -> Word8 + +min = P.min +{-# VECTORISE SCALAR min #-} + +max = P.max +{-# VECTORISE SCALAR max #-} + + +-- minimum/maximum -------------------- +minimumP, maximumP :: PArr Word8 -> Word8 + +minimumP arr = headPArr arr +{-# NOINLINE minimumP #-} +{-# VECTORISE minimumP = minimumPP #-} + +maximumP arr = headPArr arr +{-# NOINLINE maximumP #-} +{-# VECTORISE maximumP = maximumPP #-} + +minimumPP, maximumPP :: PArray Word8 :-> Word8 +minimumPP = L.closure1' (SC.fold1 P.min) (SC.fold1s P.min) +{-# INLINE minimumPP #-} +{-# NOVECTORISE minimumPP #-} + +maximumPP = L.closure1' (SC.fold1 P.max) (SC.fold1s P.max) +{-# INLINE maximumPP #-} +{-# NOVECTORISE maximumPP #-} + + +-- minIndex/maxIndex ------------------ +minIndexP :: PArr Word8 -> Int +minIndexP !_ = 0 +{-# NOINLINE minIndexP #-} +{-# VECTORISE minIndexP = minIndexPP #-} + +minIndexPP :: PArray Word8 :-> Int +minIndexPP = L.closure1' (SC.fold1Index min') (SC.fold1sIndex min') +{-# INLINE minIndexPP #-} +{-# NOVECTORISE minIndexPP #-} + +min' :: P.Ord b => (a, b) -> (a, b) -> (a, b) +min' (i,x) (j,y) | x P.<= y = (i,x) + | P.otherwise = (j,y) +{-# NOVECTORISE min' #-} + + +maxIndexP :: PArr Word8 -> Int +maxIndexP _ = 0 +{-# NOINLINE maxIndexP #-} +{-# VECTORISE maxIndexP = maxIndexPP #-} + +maxIndexPP :: PArray Word8 :-> Int +maxIndexPP = L.closure1' (SC.fold1Index max') (SC.fold1sIndex max') +{-# INLINE maxIndexPP #-} +{-# NOVECTORISE maxIndexPP #-} + +max' :: P.Ord b => (a, b) -> (a, b) -> (a, b) +max' (i,x) (j,y) | x P.>= y = (i,x) + | P.otherwise = (j,y) +{-# NOVECTORISE max' #-} + + +-- Num ------------------------------------------------------------------------ +(+), (-), (*) :: Word8 -> Word8 -> Word8 + +(+) = (P.+) +{-# VECTORISE SCALAR (+) #-} + +(-) = (P.-) +{-# VECTORISE SCALAR (-) #-} + +(*) = (P.*) +{-# VECTORISE SCALAR (*) #-} + + +-- negate/abs ------------------------- +negate, abs :: Word8 -> Word8 + +negate = P.negate +{-# VECTORISE SCALAR negate #-} + +abs = P.abs +{-# VECTORISE SCALAR abs #-} + + +-- sum/product ------------------------ +sumP, productP :: PArr Word8 -> Word8 + +sumP arr = headPArr arr +{-# NOINLINE sumP #-} +{-# VECTORISE sumP = sumPP #-} + +productP arr = headPArr arr +{-# NOINLINE productP #-} +{-# VECTORISE productP = productPP #-} + +sumPP, productPP :: PArray Word8 :-> Word8 +sumPP = L.closure1' (SC.fold (+) 0) (SC.folds (+) 0) +{-# INLINE sumPP #-} +{-# NOVECTORISE sumPP #-} + +productPP = L.closure1' (SC.fold (*) 1) (SC.folds (*) 1) +{-# INLINE productPP #-} +{-# NOVECTORISE productPP #-} + + +-- Integral ------------------------------------------------------------------- +div, mod :: Word8 -> Word8 -> Word8 + +div = P.div +{-# VECTORISE SCALAR div #-} + +mod = P.mod +{-# VECTORISE SCALAR mod #-} + + +sqrt :: Word8 -> Word8 +sqrt n = P.floor (P.sqrt (P.fromIntegral n) :: P.Double) +{-# VECTORISE SCALAR sqrt #-} + + +-- Conversion ----------------------------------------------------------------- +toInt :: Word8 -> Int +toInt = P.fromIntegral +{-# VECTORISE SCALAR toInt #-} + +fromInt :: Int -> Word8 +fromInt = P.fromIntegral +{-# VECTORISE SCALAR fromInt #-} diff --git a/Data/Array/Parallel/Prim.hs b/Data/Array/Parallel/Prim.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Parallel/Prim.hs @@ -0,0 +1,358 @@ +{-# LANGUAGE CPP #-} +#include "fusion-phases.h" + +-- | This is the API used by the vectoriser. +-- The vectoriser wants a slightly different interface to the one used +-- natively by the library. This module performs the impedance matching. +module Data.Array.Parallel.Prim + -- Core types + ( PData, PDatas, PRepr, PA(..), PR(..) + + -- Array Functions + , emptyPD + , replicatePD + , packByTagPD + , combine2PD + + -- Scalar primitives + , Scalar(..) + , scalar_map + , scalar_zipWith + , scalar_zipWith3 + + -- Types used in the generic representation + , Void, void, fromVoid, pvoid, pvoids# + , punit + , Wrap(..) + , Sum2(..), Sum3(..) + + -- Closures, and closure functions + , (:->)(..) + , closure, ($:) + , liftedClosure, liftedApply + , closure1, closure2, closure3 + + -- Selectors + , Sel2 + , tagsSel2 + , pickSel2# + , replicateSel2# + , elementsSel2_0# + , elementsSel2_1# + + , Sels2 + , lengthSels2# + + -- Scalar constructors + , emptyPA_Int#, emptyPA_Double# + , replicatePA_Int#, replicatePA_Double# + , packByTagPA_Int#, packByTagPA_Double# + , combine2PA_Int#, combine2PA_Double# + + -- Tuple constructors + , tup2, tup3, tup4, tup5) +where +import Data.Array.Parallel.PArray.PData.Base + (PArray(..), PData, PDatas, PR(..)) + +import Data.Array.Parallel.PArray.PData.Void + ( Void, void, pvoid, pvoids, fromVoid ) + +import Data.Array.Parallel.PArray.PData.Unit + ( punit ) + +import Data.Array.Parallel.PArray.PData.Sum2 + ( Sels2, lengthSels2 ) + +import Data.Array.Parallel.PArray.PRepr + ( PRepr, PA(..) + , emptyPA, replicatePA, packByTagPA, combine2PA) + +import Data.Array.Parallel.PArray.Scalar + ( Scalar(..)) + +import Data.Array.Parallel.PArray.Types + ( Wrap(..) + , Sum2(..), Sum3(..)) + +import Data.Array.Parallel.Lifted.Closure + ( (:->)(..)) + +import Data.Array.Parallel.Prelude.Tuple + ( tup2, tup3, tup4, tup5) + +import Data.Array.Parallel.Base (Tag, intToTag) +import qualified Data.Array.Parallel.Unlifted as U +import qualified Data.Array.Parallel.PArray.Scalar as Scalar +import qualified Data.Array.Parallel.Lifted.Closure as C +import GHC.Exts + + +-- Array functions ------------------------------------------------------------ +emptyPD :: PA a => PData a +emptyPD = emptyPA +{-# INLINE_PA emptyPD #-} + + +replicatePD :: PA a => Int# -> a -> PData a +replicatePD i# x + = replicatePA (I# i#) x +{-# INLINE_PA replicatePD #-} + + +packByTagPD :: PA a => PData a -> Int# -> U.Array Tag -> Int# -> PData a +packByTagPD xs _ tags tag# + = packByTagPA xs tags (I# tag#) +{-# INLINE_PA packByTagPD #-} + + +combine2PD :: PA a => Int# -> U.Sel2 -> PData a -> PData a -> PData a +combine2PD _ sel xs ys + = combine2PA sel xs ys +{-# INLINE_PA combine2PD #-} + + +-- Generic Representation ---------------------------------------------------- +pvoids# :: Int# -> PDatas Void +pvoids# n# = pvoids (I# n#) +{-# INLINE_PA pvoids# #-} + + +-- Closures ------------------------------------------------------------------- +-- The vectoriser wants versions of these functions that take unboxed +-- integers for the first argument of the lifted function. + +-- | Construct a closure. +closure :: forall a b e + . PA e + => (e -> a -> b) + -> (Int# -> PData e -> PData a -> PData b) + -> e + -> (a :-> b) + +closure fv fl e + = Clo fv + (\(I# c) v x -> fl c v x) + e +{-# INLINE_CLOSURE closure #-} + + +-- | Apply a closure. +($:) :: forall a b. (a :-> b) -> a -> b +($:) = (C.$:) +{-# INLINE_CLOSURE ($:) #-} + + +-- | Construct a lifted closure. +liftedClosure + :: forall a b e + . PA e + => (e -> a -> b) + -> (Int# -> PData e -> PData a -> PData b) + -> PData e + -> PData (a :-> b) +{-# INLINE_CLOSURE liftedClosure #-} + +liftedClosure fv fl es + = C.AClo fv + (\(I# c) v x -> fl c v x) + es + + +-- | Apply a lifted closure. +liftedApply :: Int# -> PData (a :-> b) -> PData a -> PData b +liftedApply n# arr xs + = C.liftedApply (I# n#) arr xs +{-# INLINE_CLOSURE liftedApply #-} + + +closure1 :: forall a b + . (a -> b) + -> (PArray a -> PArray b) + -> (a :-> b) +closure1 fv fl + = let fl' :: Int -> PData a -> PData b + fl' (I# c#) pdata + = case fl (PArray c# pdata) of + PArray _ pdata' -> pdata' + + in C.closure1 fv fl' +{-# INLINE_CLOSURE closure1 #-} + + +closure2 :: forall a b c. PA a + => (a -> b -> c) + -> (PArray a -> PArray b -> PArray c) + -> (a :-> b :-> c) +closure2 fv fl + = let fl' :: Int -> PData a -> PData b -> PData c + fl' (I# c#) pdata1 pdata2 + = case fl (PArray c# pdata1) (PArray c# pdata2) of + PArray _ pdata' -> pdata' + + in C.closure2 fv fl' +{-# INLINE_CLOSURE closure2 #-} + + +closure3 :: forall a b c d. (PA a, PA b) + => (a -> b -> c -> d) + -> (PArray a -> PArray b -> PArray c -> PArray d) + -> (a :-> b :-> c :-> d) +closure3 fv fl + = let fl' :: Int -> PData a -> PData b -> PData c -> PData d + fl' (I# c#) pdata1 pdata2 pdata3 + = case fl (PArray c# pdata1) (PArray c# pdata2) (PArray c# pdata3) of + PArray _ pdata' -> pdata' + + in C.closure3 fv fl' +{-# INLINE_CLOSURE closure3 #-} + + +-- Selector functions --------------------------------------------------------- +-- The vectoriser wants versions of these that take unboxed integers +-- for some arguments. +type Sel2 = U.Sel2 + + +replicateSel2# :: Int# -> Int# -> Sel2 +replicateSel2# n# tag# + = U.mkSel2 + (U.replicate n (intToTag tag)) + (U.enumFromStepLen 0 1 n) + (if tag == 0 then n else 0) + (if tag == 0 then 0 else n) + (U.mkSelRep2 (U.replicate n (intToTag tag))) + where + n = I# n# + tag = I# tag# +{-# INLINE_PA replicateSel2# #-} + + +pickSel2# :: Sel2 -> Int# -> U.Array Bool +pickSel2# sel tag# + = U.pick (U.tagsSel2 sel) (intToTag (I# tag#)) +{-# INLINE_PA pickSel2# #-} + + +tagsSel2 :: Sel2 -> U.Array Tag +tagsSel2 = U.tagsSel2 +{-# INLINE_PA tagsSel2 #-} + + +elementsSel2_0# :: Sel2 -> Int# +elementsSel2_0# sel + = case U.elementsSel2_0 sel of { I# n# -> n# } +{-# INLINE_PA elementsSel2_0# #-} + + +elementsSel2_1# :: Sel2 -> Int# +elementsSel2_1# sel + = case U.elementsSel2_1 sel of { I# n# -> n# } +{-# INLINE_PA elementsSel2_1# #-} + + +lengthSels2# :: Sels2 -> Int# +lengthSels2# sels2 + = case lengthSels2 sels2 of { I# n# -> n# } +{-# INLINE_PA lengthSels2# #-} + + +-- Scalar functions ----------------------------------------------------------- +scalar_map + :: (Scalar a, Scalar b) + => (a -> b) -> PArray a -> PArray b + +scalar_map = Scalar.map +{-# INLINE scalar_map #-} + + +scalar_zipWith + :: (Scalar a, Scalar b, Scalar c) + => (a -> b -> c) -> PArray a -> PArray b -> PArray c + +scalar_zipWith = Scalar.zipWith +{-# INLINE scalar_zipWith #-} + + +scalar_zipWith3 + :: (Scalar a, Scalar b, Scalar c, Scalar d) + => (a -> b -> c -> d) -> PArray a -> PArray b -> PArray c -> PArray d + +scalar_zipWith3 = Scalar.zipWith3 +{-# INLINE scalar_zipWith3 #-} + + +-- Int functions -------------------------------------------------------------- +type PArray_Int# = U.Array Int + + +replicatePA_Int# :: Int# -> Int# -> PArray_Int# +replicatePA_Int# n# i# = U.replicate (I# n#) (I# i#) +{-# INLINE_PA replicatePA_Int# #-} + + +emptyPA_Int# :: PArray_Int# +emptyPA_Int# = U.empty +{-# INLINE_PA emptyPA_Int# #-} + + +{-# RULES + +"replicatePA_Int#" forall n# i#. + replicatePA_Int# n# i# = U.replicate (I# n#) (I# i#) + + #-} + + +packByTagPA_Int# :: a +packByTagPA_Int# + = error "Data.Array.Parallel.Prim: 'packByTagPA_Int#' not implemented" +{-# NOINLINE packByTagPA_Int# #-} + + +combine2'PA_Int# :: PArray_Int# -> PArray_Int# -> PArray_Int# -> PArray_Int# +combine2'PA_Int# sel xs ys = U.combine (U.map (== 0) sel) xs ys +{-# INLINE_PA combine2'PA_Int# #-} + + +combine2PA_Int# + :: Int# + -> PArray_Int# -> PArray_Int# + -> PArray_Int# -> PArray_Int# -> PArray_Int# +combine2PA_Int# _ sel _ xs ys = combine2'PA_Int# sel xs ys +{-# INLINE_PA combine2PA_Int# #-} + + +-- Double functions ----------------------------------------------------------- +type PArray_Double# = U.Array Double + + +replicatePA_Double# :: Int# -> Double# -> PArray_Double# +replicatePA_Double# n# d# = U.replicate (I# n#) (D# d#) +{-# INLINE_PA replicatePA_Double# #-} + + +emptyPA_Double# :: PArray_Double# +emptyPA_Double# = U.empty +{-# INLINE_PA emptyPA_Double# #-} + + +packByTagPA_Double# :: a +packByTagPA_Double# + = error "Data.Array.Parallel.Prim: 'packByTagPA_Double#' not implemented" +{-# NOINLINE packByTagPA_Double# #-} + + +combine2'PA_Double# + :: PArray_Int# + -> PArray_Double# -> PArray_Double# -> PArray_Double# +combine2'PA_Double# sel xs ys = U.combine (U.map (== 0) sel) xs ys +{-# INLINE_PA combine2'PA_Double# #-} + + +combine2PA_Double# + :: Int# + -> PArray_Int# -> PArray_Int# + -> PArray_Double# -> PArray_Double# -> PArray_Double# +combine2PA_Double# _ sel _ xs ys = combine2'PA_Double# sel xs ys +{-# INLINE_PA combine2PA_Double# #-} diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,36 @@ +Copyright (c) 2001-2012, The DPH Team + +The DPH Team is: + Manuel M T Chakravarty + Gabriele Keller + Roman Leshchinskiy + Ben Lippmeier + George Roldugin + +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 name of the University 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 UNIVERSITY COURT OF THE UNIVERSITY OF +GLASGOW AND THE CONTRIBUTORS "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 THE +UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS 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. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple +main = defaultMain + diff --git a/dph-lifted-vseg.cabal b/dph-lifted-vseg.cabal new file mode 100644 --- /dev/null +++ b/dph-lifted-vseg.cabal @@ -0,0 +1,103 @@ +Name: dph-lifted-vseg +Version: 0.6.0.1 +License: BSD3 +License-File: LICENSE +Author: The DPH Team +Maintainer: Ben Lippmeier +Homepage: http://www.haskell.org/haskellwiki/GHC/Data_Parallel_Haskell +Category: Data Structures +Synopsis: Data Parallel Haskell lifted array combinators. +Description: This package provides the following: + nested arrays and the primitive operators that work on them (PA functions); + the lifted array combinators that the vectoriser introduces (PP functions); + the user facing library functions that work on [::] style arrays (P functions). + This implementation directly encodes sharing between array segments, + and avoids the copying that dph-lifted-copy would otherwise do. + Use this version for production code. + +Cabal-Version: >= 1.6 +Build-Type: Simple + +Library + Exposed-Modules: + Data.Array.Parallel.Lifted.Closure + Data.Array.Parallel.Lifted.Combinators + Data.Array.Parallel.Lifted + Data.Array.Parallel.PArray.PData.Base + Data.Array.Parallel.PArray.PData.Double + Data.Array.Parallel.PArray.PData.Int + Data.Array.Parallel.PArray.PData.Word8 + Data.Array.Parallel.PArray.PData.Nested + Data.Array.Parallel.PArray.PData.Sum2 + Data.Array.Parallel.PArray.PData.Tuple2 + Data.Array.Parallel.PArray.PData.Tuple3 + Data.Array.Parallel.PArray.PData.Tuple4 + Data.Array.Parallel.PArray.PData.Tuple5 + Data.Array.Parallel.PArray.PData.Unit + Data.Array.Parallel.PArray.PData.Void + Data.Array.Parallel.PArray.PData.Wrap + Data.Array.Parallel.PArray.PData + Data.Array.Parallel.PArray.PRepr.Base + Data.Array.Parallel.PArray.PRepr.Instances + Data.Array.Parallel.PArray.PRepr.Nested + Data.Array.Parallel.PArray.PRepr.Tuple + Data.Array.Parallel.PArray.PRepr + Data.Array.Parallel.PArray.Scalar + Data.Array.Parallel.PArray + Data.Array.Parallel.Prelude.Base + Data.Array.Parallel.Prelude.Bool + Data.Array.Parallel.Prelude.Double + Data.Array.Parallel.Prelude.Int + Data.Array.Parallel.Prelude.Word8 + Data.Array.Parallel.Prelude.Tuple + Data.Array.Parallel.Prelude.Ordering + Data.Array.Parallel.Prelude + Data.Array.Parallel + Data.Array.Parallel.Prim + + Exposed: + False + + Extensions: + BangPatterns, + PatternGuards + TypeFamilies, + TypeOperators, + RankNTypes, + BangPatterns, + MagicHash, + UnboxedTuples, + TypeOperators, + FlexibleContexts, + FlexibleInstances, + EmptyDataDecls, + NoMonomorphismRestriction, + MultiParamTypeClasses, + EmptyDataDecls, + StandaloneDeriving, + ExplicitForAll, + ParallelListComp, + ExistentialQuantification, + ScopedTypeVariables, + PatternGuards, + PackageImports + + GHC-Options: + -Odph + -fcpr-off -fno-liberate-case -fno-spec-constr + -Wall + -fno-warn-missing-methods + -fno-warn-orphans + + Build-Depends: + base == 4.5.*, + ghc == 7.*, + array == 0.4.*, + random == 1.0.*, + template-haskell == 2.7.*, + dph-base == 0.6.*, + dph-prim-par == 0.6.*, + dph-lifted-base == 0.6.*, + vector == 0.9.*, + pretty == 1.1.*, + containers == 0.4.*