packages feed

dph-lifted-vseg (empty) → 0.6.0.1

raw patch · 37 files changed

+7671/−0 lines, 37 filesdep +arraydep +basedep +containerssetup-changed

Dependencies added: array, base, containers, dph-base, dph-lifted-base, dph-prim-par, ghc, pretty, random, template-haskell, vector

Files

+ Data/Array/Parallel.hs view
@@ -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 #-}
+ Data/Array/Parallel/Lifted.hs view
@@ -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++++        +        +        +
+ Data/Array/Parallel/Lifted/Closure.hs view
@@ -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
+ Data/Array/Parallel/Lifted/Combinators.hs view
@@ -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 #-}+
+ Data/Array/Parallel/PArray.hs view
@@ -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 #-}+
+ Data/Array/Parallel/PArray/PData.hs view
@@ -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+
+ Data/Array/Parallel/PArray/PData/Base.hs view
@@ -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]+
+ Data/Array/Parallel/PArray/PData/Double.hs view
@@ -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)+
+ Data/Array/Parallel/PArray/PData/Int.hs view
@@ -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)
+ Data/Array/Parallel/PArray/PData/Nested.hs view
@@ -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))++
+ Data/Array/Parallel/PArray/PData/Sum2.hs view
@@ -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)])++
+ Data/Array/Parallel/PArray/PData/Tuple2.hs view
@@ -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)+
+ Data/Array/Parallel/PArray/PData/Tuple3.hs view
@@ -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)
+ Data/Array/Parallel/PArray/PData/Tuple4.hs view
@@ -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)++                 +
+ Data/Array/Parallel/PArray/PData/Tuple5.hs view
@@ -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)++                 +
+ Data/Array/Parallel/PArray/PData/Unit.hs view
@@ -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 ++ " ]"+
+ Data/Array/Parallel/PArray/PData/Void.hs view
@@ -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"+
+ Data/Array/Parallel/PArray/PData/Word8.hs view
@@ -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)+
+ Data/Array/Parallel/PArray/PData/Wrap.hs view
@@ -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+        ++
+ Data/Array/Parallel/PArray/PRepr.hs view
@@ -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
+ Data/Array/Parallel/PArray/PRepr/Base.hs view
@@ -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)+
+ Data/Array/Parallel/PArray/PRepr/Instances.hs view
@@ -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+
+ Data/Array/Parallel/PArray/PRepr/Nested.hs view
@@ -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 #-}+
+ Data/Array/Parallel/PArray/PRepr/Tuple.hs view
@@ -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++
+ Data/Array/Parallel/PArray/Scalar.hs view
@@ -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)+
+ Data/Array/Parallel/Prelude.hs view
@@ -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   ()
+ Data/Array/Parallel/Prelude/Base.hs view
@@ -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 #-}
+ Data/Array/Parallel/Prelude/Bool.hs view
@@ -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 #-}
+ Data/Array/Parallel/Prelude/Double.hs view
@@ -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 #-}
+ Data/Array/Parallel/Prelude/Int.hs view
@@ -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 #-}
+ Data/Array/Parallel/Prelude/Ordering.hs view
@@ -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 #-}
+ Data/Array/Parallel/Prelude/Tuple.hs view
@@ -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 #-}
+ Data/Array/Parallel/Prelude/Word8.hs view
@@ -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 #-}
+ Data/Array/Parallel/Prim.hs view
@@ -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# #-}
+ LICENSE view
@@ -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.+
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+
+ dph-lifted-vseg.cabal view
@@ -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 <benl@cse.unsw.edu.au>+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.*