dph-common-vseg: refactor to use PDatas in nested arrays instead of plain Vectors...
authorBen Lippmeier <benl@ouroborus.net>
Tue, 25 Oct 2011 06:38:28 +0000 (17:38 +1100)
committerBen Lippmeier <benl@ouroborus.net>
Thu, 3 Nov 2011 05:26:53 +0000 (16:26 +1100)
23 files changed:
dph-base/Data/Array/Parallel/Pretty.hs
dph-lifted-vseg/Data/Array/Parallel/Lifted/Combinators.hs
dph-lifted-vseg/Data/Array/Parallel/PArray.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Base.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Double.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Int.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Nested.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Sum2.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Tuple.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Unit.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Void.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Wrap.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PRepr.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PRepr/Base.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PRepr/Instances.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PRepr/Nested.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PRepr/Tuple.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/Scalar.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/Types.hs
dph-lifted-vseg/Data/Array/Parallel/VectDepend.hs
dph-lifted-vseg/dph-lifted-vseg.cabal
dph-lifted-vseg/examples/Sums.hs [new file with mode: 0644]

index c311a26..9e4b419 100644 (file)
@@ -11,11 +11,22 @@ import Text.PrettyPrint
 -- | Pretty print physical structure of data.
 class PprPhysical a where
  pprp :: a -> Doc
+
+instance PprPhysical Int where
+ pprp = text . show 
+instance PprPhysical Double where
+ pprp = text . show 
  
  
 -- | Pretty print virtual \/ logical structure of data.
 class PprVirtual a where
  pprv :: a -> Doc
 
+instance PprVirtual Int where
+ pprp = text . show 
  
+instance PprVirtual Double where
+ pprp = text . show 
+
  
\ No newline at end of file
index db84b2c..9f71e74 100644 (file)
@@ -49,8 +49,6 @@ import qualified Data.Array.Parallel.Unlifted   as U
 import qualified Data.Vector                    as V
 import GHC.Exts
 
-nope    = error "Data.Array.Parallel.Lifted.Combinators: can't use unvectorised definition"
-
 
 -- Conversions ================================================================
 -- The following identity functions are used as the vectorised versions of the
@@ -147,18 +145,24 @@ slicePP         = closure3' PA.slice PA.slicel
 mapPP   :: (PA a, PA b) 
         => (a :-> b) :-> PArray a :-> PArray b
 
-{-# INLINE_PA mapPP #-}
 mapPP   = closure2' mapPP_v mapPP_l
- where
-        {-# INLINE mapPP_v #-}
-        mapPP_v f as
-                = PA.replicate (PA.length as) f $:^ as
+{-# INLINE_PA mapPP #-}
 
-        {-# INLINE mapPP_l #-}
-        mapPP_l fs ass
-                =   PA.unconcat ass 
-                $   PA.replicates (PA.unsafeTakeSegd ass) fs
-                $:^ PA.concat ass
+
+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.unsafeTakeSegd ass) fs
+        $:^ PA.concat ass
+{-# INLINE mapPP_l #-}
 
 
 -- | Apply a worker function to every pair of two arrays.
@@ -185,7 +189,13 @@ zipWithPP = closure3' zipWithPP_v zipWithPP_l
 -- | Extract the elements from an array that match the given predicate.
 filterPP :: PA a => (a :-> Bool) :-> PArray a :-> PArray a
 {-# INLINE filterPP #-}
-filterPP = nope
+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 ------------------------------------------------------------
index 41e7f2b..b2db8fe 100644 (file)
@@ -3,11 +3,22 @@
 
 -- | Functions that work directly on PArrays.
 
---   * The functions in this module are used by the D.A.P.Lifted.Closure module to
+--   * The functions in this module are used by the D.A.P.Lifted.Combinator module to
 --     define the closures that the vectoriser uses.
 --
 --   * The functions in this module may also be used directly by user programs.
 --
+--   * In general, these functions 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 make this module export 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.
+-- 
 module Data.Array.Parallel.PArray 
         ( PArray(..)
         , valid
@@ -31,6 +42,7 @@ module Data.Array.Parallel.PArray
         , unsafeTakeSegd
 
         -- * Pack and Combine
+        , pack,         packl
         , packByTag
         , combine2
 
@@ -125,7 +137,7 @@ replicatel (PArray n# (PInt lens)) (PArray _ pdata)
                 lens
                 (U.indicesSegd segd)
                 (U.replicate c 0)
-                (V.singleton pdata)
+                (error "PArray: replcatel fixme") -- (singletondPR pdata)
 {-# INLINE_PA replicatel #-}
 
 
@@ -155,8 +167,8 @@ appendl (PArray n# pdata1) (PArray _ pdata2)
 -- | Concatenate a nested array.
 concat :: PA a => PArray (PArray a) -> PArray a
 concat (PArray _ darr)
- = let  darr'   = concatPA darr
-        I# n#   = lengthPA darr'
+ = let  darr'    = concatPA darr
+        !(I# n#) = lengthPA darr'
    in   PArray  n# darr'
 {-# INLINE_PA concat #-}
 
@@ -169,21 +181,21 @@ concatl (PArray n# pdata1)
 
 
 -- | Impose a nesting structure on a flat array
-unconcat :: PA a => PArray (PArray a) -> PArray b -> PArray (PArray b)
+unconcat :: (PA a, PA b) => PArray (PArray a) -> PArray b -> PArray (PArray b)
 unconcat (PArray n# pdata1) (PArray _ pdata2)
-        = PArray n# $ unconcatPD pdata1 pdata2
+        = 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 :: U.Segd -> PArray a -> PArray (PArray a)
+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) (V.singleton pdata)       
+       $ PNested (U.promoteSegdToVSegd segd) (singletondPA pdata)      
 
         | otherwise
         = error $ unlines
@@ -211,7 +223,7 @@ index (PArray _ arr) ix
 -- | 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)
-        = PArray n# (indexlPA (I# n#) darr ixs)
+        = PArray n# (indexlPA darr ixs)
 {-# INLINE_PA indexl #-}
 
 
@@ -224,11 +236,13 @@ extract (PArray _ arr) start len@(I# len#)
 
 -- | Segmented extract.
 extracts :: PA a => Vector (PArray a) -> U.SSegd -> PArray a
-extracts arrs ssegd
+extracts 
+        = error "PArray extracts fixme"
+{- arrs ssegd
  = let  vecs            = V.map (\(PArray _ vec) -> vec) arrs
         !(I# n#)        = (U.sum $ U.lengthsSSegd ssegd)
    in  PArray   n#
-                (extractsPA vecs ssegd)
+                (extractsPA vecs ssegd) -}
 {-# INLINE_PA extracts #-}
 
 
@@ -258,6 +272,51 @@ unsafeTakeSegd (PArray _ pdata)
 
 
 -- 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 (PArray _ xs) (PArray _ (PBool sel2))
+ = 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'
+
+
+-- | Lifted pack.
+--   Both data and tag arrays must have the same segmentation structure, 
+--   but this is not checked.
+packl :: forall a. PA a => PArray (PArray a) -> PArray (PArray Bool) -> PArray (PArray a)
+packl xss bss
+ | PArray n# (PNested vsegd xdatas)     <- xss
+ , PArray _  (PNested _     bdatas)     <- bss
+ = let  
+        -- Split up the vsegd into its parts.
+        vsegids         = U.takeVSegidsOfVSegd  vsegd
+        ssegd           = U.takeSSegdOfVSegd    vsegd
+
+        -- Gather the scattered data together into contiguous arrays, 
+        -- which is the form packByTag needs.
+        xdata_contig            = extractsPA xdatas ssegd
+        bdata'@(PBool sel2)     = extractsPA bdatas ssegd
+        tags                    = U.tagsSel2 sel2
+         
+        -- Pack all the psegs.
+        xdata'          = packByTagPA xdata_contig tags 1
+
+        -- Rebuild the segd to account for the possibly smaller segments.
+        segd            = U.lengthsToSegd $ U.lengthsSSegd ssegd
+        segd'           = U.lengthsToSegd $ U.count_s segd tags 1
+
+        -- Reattach the vsegids, because the top level sharing structure
+        -- of the array is unchanged under pack.
+        vsegd'          = U.mkVSegd vsegids (U.promoteSegdToSSegd segd')
+
+   in   PArray n# (PNested vsegd' (singletondPA xdata'))
+      
+
+
 -- | Filter an array based on some tags.
 packByTag :: PA a => PArray a -> U.Array Tag -> Tag -> PArray a
 packByTag (PArray _ darr) tags tag
index d80e089..c56db3b 100644 (file)
@@ -7,7 +7,9 @@ module Data.Array.Parallel.PArray.PData
         , module Data.Array.Parallel.PArray.PData.Nested
         , module Data.Array.Parallel.PArray.PData.Unit
         , module Data.Array.Parallel.PArray.PData.Tuple
-        , module Data.Array.Parallel.PArray.PData.Void)
+        , module Data.Array.Parallel.PArray.PData.Void
+        , mapdPR
+        , zipWithdPR)
 where
 import Data.Array.Parallel.PArray.PData.Base
 import Data.Array.Parallel.PArray.PData.Wrap
@@ -18,5 +20,28 @@ import Data.Array.Parallel.PArray.PData.Sum2
 import Data.Array.Parallel.PArray.PData.Unit
 import Data.Array.Parallel.PArray.PData.Tuple
 import Data.Array.Parallel.PArray.PData.Void
+import Data.Array.Parallel.PArray.PRepr.Instances
+import Data.Array.Parallel.Base                 (Tag)
+import qualified Data.Array.Parallel.Unlifted   as U
+import qualified Data.Vector                    as V
 
 
+
+-- | Apply a worked function to all PData in a collection.
+mapdPR  :: (PR a, PR b)
+        => (PData a -> PData b)
+        -> PDatas a -> PDatas b
+mapdPR f pdatas
+        = fromVectordPR $ V.map f (toVectordPR pdatas)
+
+
+-- | Combine all PData in a collection with an operator.
+zipWithdPR
+        :: (PR a, PR b, PR c)
+        => (PData a -> PData b  -> PData c)
+        -> PDatas a -> PDatas b -> PDatas c
+zipWithdPR f pdatas1 pdatas2
+        = fromVectordPR $ V.zipWith f 
+                (toVectordPR pdatas1)
+                (toVectordPR pdatas2)
+
index ef9fee9..34090b1 100644 (file)
@@ -8,19 +8,19 @@ module Data.Array.Parallel.PArray.PData.Base
           PArray(..)
         , length, unpack
         , PprPhysical (..), PprVirtual (..)
-        , PData
-        , PR(..)
-        
+
+        , PR (..)
+        , PData(..), PDatas(..)
         , uextracts)
 where
-import qualified Data.Array.Parallel.Unlifted   as U
-import qualified Data.Vector                    as V
-import qualified Data.Vector.Unboxed            as VU
-import Data.Vector                              (Vector)
-import Data.Array.Parallel.Base                 (Tag)
 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 qualified Data.Vector.Unboxed            as VU
 import Prelude hiding (length)
 
 -- PArray ---------------------------------------------------------------------
@@ -39,19 +39,6 @@ import Prelude hiding (length)
 data PArray a
         = PArray Int# (PData  a)
 
-deriving instance (Show (PData a), Show a)
-        => Show (PArray a)
-
-instance (PprPhysical (PData a)) => PprPhysical (PArray a) where
- pprp (PArray n# dat)
-  =   (text "PArray " <+> int (I# n#))
-  $+$ (nest 4 
-      $ pprp dat)
-
-instance PprVirtual (PData a) => PprVirtual (PArray a) where
- pprv (PArray _ dat)
-  =   pprv dat
-
 
 -- | Take the length of an array
 {-# INLINE_PA length #-}
@@ -65,13 +52,25 @@ unpack :: PArray a -> PData a
 unpack (PArray _ d)   = d
 
 
--- PData ----------------------------------------------------------------------
--- | Parallel array data.
+-- Parallel array data --------------------------------------------------------
+{-# ANN type PData NoSpecConstr #-}
 data family PData a
 
+{-# 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 (V.Vector (U.Array Int))
 
--- PR Dictionary (Representation) ---------------------------------------------
+
+-- PR -------------------------------------------------------------------------
 class PR a where
+
   -- | 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
@@ -107,23 +106,22 @@ class PR a where
                 -> PData a              -- ^ data elements to replicate
                 -> PData a
 
-  -- | Lookup a single element from the source array.
-  --   O(1). 
+  -- | O(1). Lookup a single element from the source array.
   indexPR       :: PData a    -> Int -> a
 
   -- | Lookup several elements from several source arrays
-  indexlPR      :: Int -> PData (PArray a) -> PData Int -> PData a
+  indexlPR      :: PData (PArray a)
+                -> PData Int
+                -> PData a
 
-  -- | Extract a range of elements from an array.
-  --   O(n). 
+  -- | O(n). Extract a range of elements from an array.
   extractPR     :: PData a 
                 -> Int                  -- ^ starting index
                 -> Int                  -- ^ length of slice
                 -> PData a
 
-  -- | Segmented extract.
-  --   O(sum seglens).  
-  extractsPR    :: Vector (PData a)
+  -- | O(sum seglens). Segmented extract.
+  extractsPR    :: PDatas a
                 -> U.SSegd              -- ^ segment descriptor describing scattering of data.
                 -> PData a
 
@@ -155,6 +153,46 @@ class PR a where
   -- | 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). Combine several collections of PData into a single one.
+  concatdPR     :: V.Vector (PDatas a) -> PDatas a
+
+  -- | O(n). Convert a vector of PData to a PDatas collection.
+  fromVectordPR :: V.Vector (PData a) -> PDatas a
+
+  -- | O(n). Convert a PDatas collection to a vector of PData.
+  toVectordPR   :: PDatas a           -> V.Vector (PData a)
+
+
+-- Show -----------------------------------------------------------------------
+deriving instance (Show (PData a), Show a)
+        => Show (PArray a)
+
+instance (PprPhysical (PData a)) => PprPhysical (PArray a) where
+ pprp (PArray n# dat)
+  =   (text "PArray " <+> int (I# n#))
+  $+$ (nest 4 
+      $ pprp dat)
+
+instance PprVirtual (PData a) => PprVirtual (PArray a) where
+ pprv (PArray _ dat)
+  =   pprv dat
+
 
 -------------------------------------------------------------------------------
 -- extra unlifted primitives should be moved into unlifted library ------------
@@ -204,3 +242,4 @@ uextracts arrs srcids ixBase lens
                         (U.zip baseixs srcids')
 
    in result
+
index 9ce46c7..ffe7073 100644 (file)
@@ -11,19 +11,10 @@ import Text.PrettyPrint
 data instance PData Double
         = PDouble !(U.Array Double)
 
-deriving instance Show (PData Double)
+data instance PDatas Double
+        = PDoubles !(V.Vector (U.Array Double))
 
 
-instance PprPhysical (PData Double) where
-  pprp (PDouble vec)
-   =   text "PDouble"
-   <+> text (show $ U.toList vec)
-
-
-instance PprVirtual (PData Double) where
-  pprv (PDouble vec)
-   = text (show $ U.toList vec)
-
 
 instance PR Double where
   {-# INLINE_PDATA validPR #-}
@@ -55,7 +46,7 @@ instance PR Double where
         = arr `VU.unsafeIndex` ix
 
   {-# INLINE_PDATA indexlPR #-}
-  indexlPR _ arr@(PNested vsegd psegdatas) (PInt ixs)
+  indexlPR arr@(PNested vsegd (PDoubles vecpdatas)) (PInt ixs)
    = PDouble $ U.zipWith get vsegids ixs
    where
          -- Unbox these vectors outside the get loop.
@@ -63,15 +54,14 @@ instance PR Double where
          !ssegd         = U.takeSSegdRedundantOfVSegd vsegd
          !psegsrcids    = U.sourcesSSegd ssegd
          !psegstarts    = U.startsSSegd  ssegd
-         !psegvecs      = V.map (\(PDouble vec) -> vec) psegdatas
 
          -- Lookup a single element from a virtual segment.
          get !vsegid !ix
           = let !psegsrcid       = psegsrcids `VU.unsafeIndex` vsegid
-                !psegvec         = psegvecs   `V.unsafeIndex`  psegsrcid
+                !psegvec         = vecpdatas  `V.unsafeIndex` psegsrcid
                 !psegstart       = psegstarts `VU.unsafeIndex` vsegid
                 !elemIx          = psegstart + ix
-                !elemVal         = psegvec `VU.unsafeIndex` elemIx
+                !elemVal         = psegvec    `VU.unsafeIndex` elemIx
             in  elemVal
 
   {-# INLINE_PDATA extractPR #-}
@@ -79,12 +69,11 @@ instance PR Double where
         = PDouble (U.extract arr start len)
 
   {-# INLINE_PDATA extractsPR #-}
-  extractsPR arrs ussegd
+  extractsPR (PDoubles vecpdatas) ussegd
    = let segsrcs        = U.sourcesSSegd ussegd
          segstarts      = U.startsSSegd  ussegd
          seglens        = U.lengthsSSegd ussegd
-     in  PDouble (uextracts (V.map (\(PDouble arr) -> arr) arrs)
-                        segsrcs segstarts seglens)
+     in  PDouble (uextracts vecpdatas segsrcs segstarts seglens)
                 
   {-# INLINE_PDATA appendPR #-}
   appendPR (PDouble arr1) (PDouble arr2)
@@ -111,3 +100,51 @@ instance PR Double where
   {-# INLINE_PDATA toVectorPR #-}
   toVectorPR (PDouble arr)
         = V.fromList $ U.toList arr
+
+  -- PDatas -------------------------------------
+  {-# INLINE_PDATA emptydPR #-}
+  emptydPR 
+        = PDoubles $ V.empty
+        
+  {-# INLINE_PDATA singletondPR #-}
+  singletondPR (PDouble pdata)
+        = PDoubles $ V.singleton pdata
+        
+  {-# INLINE_PDATA lengthdPR #-}
+  lengthdPR (PDoubles vec)
+        = V.length vec
+        
+  {-# INLINE_PDATA indexdPR #-}
+  indexdPR (PDoubles vec) ix
+        = PDouble $ V.unsafeIndex vec ix
+
+  {-# INLINE_PDATA appenddPR #-}
+  appenddPR (PDoubles xs) (PDoubles ys)
+        = PDoubles $ xs V.++ ys
+        
+  {-# INLINE_PDATA concatdPR #-}
+  concatdPR vecs
+        = PDoubles
+                $ V.concat $ V.toList
+                $ V.map (\(PDoubles xs) -> xs) vecs
+                
+  {-# INLINE_PDATA fromVectordPR #-}
+  fromVectordPR vec
+        = PDoubles $ V.map (\(PDouble xs) -> xs) vec
+        
+  {-# INLINE_PDATA toVectordPR #-}
+  toVectordPR (PDoubles vec)
+        = V.map PDouble vec
+
+
+-- Show -----------------------------------------------------------------------
+deriving instance Show (PData Double)
+
+instance PprPhysical (PData Double) where
+  pprp (PDouble vec)
+   =   text "PDouble"
+   <+> text (show $ U.toList vec)
+
+instance PprVirtual (PData Double) where
+  pprv (PDouble vec)
+   = text (show $ U.toList vec)
index e05b94a..ed5b82f 100644 (file)
@@ -5,23 +5,9 @@ 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
+import qualified Data.Vector.Unboxed            as VU
 import Text.PrettyPrint
-
-
--- Show -----------------------------------------------------------------------
-deriving instance Show (PData Int)
-
-
-instance PprPhysical (PData Int) where
-  pprp (PInt vec)
-   =   text "PInt"
-   <+> text (show $ U.toList vec)
-
-
-instance PprVirtual (PData Int) where
-  pprv (PInt vec)
-   = text (show $ U.toList vec)
-
+import Prelude                                  as P
 
 -- PR -------------------------------------------------------------------------
 instance PR Int where
@@ -54,25 +40,34 @@ instance PR Int where
         = arr U.!: ix
 
   {-# INLINE_PDATA indexlPR #-}
-  indexlPR _ arr (PInt ixs)
-        = PInt
-        $ U.zipWith (\vsegid ix 
-                        -> ((pnested_psegdata arr) V.! ((pnested_psegsrcids arr)  U.!: vsegid)) 
-                                   `indexPR` ((pnested_psegstarts arr) U.!: vsegid + ix))
-                    (pnested_vsegids arr) ixs
-
+  indexlPR arr@(PNested vsegd (PInts vecpdatas)) (PInt ixs)
+   = PInt $ U.zipWith get vsegids ixs
+   where
+         -- Unbox these vectors outside the get loop.
+         !vsegids       = U.takeVSegidsRedundantOfVSegd vsegd
+         !ssegd         = U.takeSSegdRedundantOfVSegd vsegd
+         !psegsrcids    = U.sourcesSSegd ssegd
+         !psegstarts    = U.startsSSegd  ssegd
+
+         -- Lookup a single element from a virtual segment.
+         get !vsegid !ix
+          = let !psegsrcid       = psegsrcids `VU.unsafeIndex` vsegid
+                !psegvec         = vecpdatas  `V.unsafeIndex` psegsrcid
+                !psegstart       = psegstarts `VU.unsafeIndex` vsegid
+                !elemIx          = psegstart + ix
+                !elemVal         = psegvec    `VU.unsafeIndex` elemIx
+            in  elemVal
 
   {-# INLINE_PDATA extractPR #-}
   extractPR (PInt arr) start len 
         = PInt (U.extract arr start len)
 
   {-# INLINE_PDATA extractsPR #-}
-  extractsPR arrs ussegd
+  extractsPR (PInts vecpdatas) ussegd
    = let segsrcs        = U.sourcesSSegd ussegd
          segstarts      = U.startsSSegd  ussegd
          seglens        = U.lengthsSSegd ussegd
-     in  PInt (uextracts (V.map (\(PInt arr) -> arr) arrs)
-                        segsrcs segstarts seglens)
+     in  PInt (uextracts vecpdatas segsrcs segstarts seglens)
                 
   {-# INLINE_PDATA appendPR #-}
   appendPR (PInt arr1) (PInt arr2)
@@ -100,3 +95,57 @@ instance PR Int where
   toVectorPR (PInt arr)
         = V.fromList $ U.toList arr
 
+  -- PRR ----------------------------------------
+  {-# INLINE_PDATA emptydPR #-}
+  emptydPR 
+        = PInts $ V.empty
+        
+  {-# INLINE_PDATA singletondPR #-}
+  singletondPR (PInt pdata)
+        = PInts $ V.singleton pdata
+        
+  {-# INLINE_PDATA lengthdPR #-}
+  lengthdPR (PInts vec)
+        = V.length vec
+        
+  {-# INLINE_PDATA indexdPR #-}
+  indexdPR (PInts vec) ix
+        = PInt $ V.unsafeIndex vec ix
+
+  {-# INLINE_PDATA appenddPR #-}
+  appenddPR (PInts xs) (PInts ys)
+        = PInts $ xs V.++ ys
+        
+  {-# INLINE_PDATA concatdPR #-}
+  concatdPR vecs
+        = PInts $ V.concat $ V.toList
+                $ V.map (\(PInts xs) -> xs) vecs
+                                
+  {-# INLINE_PDATA fromVectordPR #-}
+  fromVectordPR vec
+        = PInts $ V.map (\(PInt xs) -> xs) vec
+        
+  {-# INLINE_PDATA toVectordPR #-}
+  toVectordPR (PInts vec)
+        = V.map PInt vec
+
+
+-- Show -----------------------------------------------------------------------
+deriving instance Show (PData Int)
+
+instance PprPhysical (U.Array Int) where
+  pprp uarr 
+   =    text (show $ U.toList uarr)
+
+instance PprPhysical (PData Int) where
+  pprp (PInt uarr)
+   =    text "PInt" <+> pprp uarr
+
+instance PprPhysical (PDatas Int) where
+  pprp (PInts vecs)
+   =    text "PInts" $+$ (nest 4 $ vcat $ P.map pprp $ V.toList vecs)
+
+
+instance PprVirtual (PData Int) where
+  pprv (PInt vec)
+   = text (show $ U.toList vec)
index 97789ba..288fb9b 100644 (file)
@@ -6,6 +6,7 @@
 
 module Data.Array.Parallel.PArray.PData.Nested 
         ( PData(..)
+        , PDatas(..)
         , mkPNested
         , pnested_vsegids
         , pnested_pseglens
@@ -18,15 +19,14 @@ module Data.Array.Parallel.PArray.PData.Nested
         , validBool
                 
         -- * Functions derived from PR primops
-        , concatPR
-        , concatlPR
+        , concatPR,     concatlPR
+        , unconcatPR
         , appendlPR
         , unsafeFlattenPR
 
         -- * Functions that work on nested PData arrays but don't care
         --   about the element type, and need no dictionary.
         , unsafeTakeSegdPD
-        , unconcatPD
         , slicelPD)
 where
 import Data.Array.Parallel.PArray.PRepr.Base
@@ -40,12 +40,6 @@ import qualified Data.Vector.Unboxed            as VU
 import Text.PrettyPrint
 import GHC.Exts
 
-
--- Nested arrays --------------------------------------------------------------
-
-data instance PData Int
-        = PInt (U.Array Int)
-
 -- TODO: Using plain V.Vector for the psegdata field means that operations on
 --       this field aren't parallelised. In particular, when we append two
 --       psegdata fields during appPR or combinePR this runs sequentially
@@ -53,13 +47,22 @@ data instance PData Int
 -- TODO: Should make a new type familty PDatas to hold the vector of datas 
 --       for all the segment slices.
 --
+
+-- 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     :: !(V.Vector (PData a)) }
+        , pnested_psegdata     :: !(PDatas a) }
+
+data instance PDatas (PArray a)
+        = PNesteds (V.Vector (PData (PArray a)))
+
+data instance PDatas (PData a)
+        = PPDatas (V.Vector (PData a))
+
 
 -- TODO: we shouldn't be using these directly.
 pnested_vsegids    = U.takeVSegidsOfVSegd . pnested_uvsegd
@@ -74,45 +77,10 @@ mkPNested vsegids pseglens psegstarts psegsrcids psegdata
                         $ U.lengthsToSegd pseglens)
                 psegdata
 
--- | Pretty print the physical representation of a nested array
-instance PprPhysical (PData a) => PprPhysical (PData (PArray a)) where
- pprp (PNested uvsegd pdata)
-  =   text "PNested"
-  $+$ (nest 4 $ vcat 
-        $ pprp uvsegd 
-        : [ int n <> colon <> text " " <> pprp pd
-                | n  <- [0..]
-                | pd <- V.toList pdata])
-
-
-instance (PR a, PprVirtual (PData a)) => PprVirtual (PData (PArray a)) where
- pprv arr
-  =   lbrack <> hcat (punctuate comma (map pprv $ V.toList $ toVectorPR arr)) <> rbrack
-
-     
-deriving instance Show (PData a) 
-        => Show (PData (PArray a))
-
-
--- Testing --------------------------------------------------------------------
--- TODO: shift this stuff into dph-base
-validIx  :: String -> Int -> Int -> Bool
-validIx str len ix 
-        = check str len ix (ix >= 0 && ix < len)
-
-validLen :: String -> Int -> Int -> Bool
-validLen str len ix 
-        = checkLen str len ix (ix >= 0 && ix <= len)
-
--- TODO: slurp debug flag from base 
-validBool :: String -> Bool -> Bool
-validBool str b
-        = if b  then True 
-                else error $ "validBool check failed -- " ++ str
-
 
 instance U.Elt (Int, Int, Int)
 
+
 -- PR Instances ---------------------------------------------------------------
 instance PR a => PR (PArray a) where
 
@@ -147,7 +115,7 @@ instance PR a => PR (PArray a) where
          psegsrcsRefOK
                 = validBool "nested array psegsrc doesn't ref flat array"
                 $ U.and 
-                $ U.map (\srcid -> srcid < V.length psegdata) psegsrcs
+                $ U.map (\srcid -> srcid < lengthdPR psegdata) psegsrcs
 
          -- Every physical segment must be a valid slice of the corresponding flat array.
          -- 
@@ -169,7 +137,7 @@ instance PR a => PR (PArray a) where
                 $ U.and 
                 $ U.zipWith3 
                         (\len start srcid
-                           -> let srclen = lengthPR (psegdata V.! srcid)
+                           -> let srclen = lengthPR (psegdata `indexdPR` srcid)
                               in  and [    (len == 0 && start <= srclen)
                                         || validIx  "nested array psegstart " srclen start
                                       ,    validLen "nested array pseglen   " srclen (start + len)])
@@ -191,7 +159,7 @@ instance PR a => PR (PArray a) where
 
 
   {-# INLINE_PDATA emptyPR #-}
-  emptyPR = PNested U.emptyVSegd V.empty
+  emptyPR = PNested U.emptyVSegd emptydPR
 
 
   {-# INLINE_PDATA nfPR #-}
@@ -214,7 +182,7 @@ instance PR a => PR (PArray a) where
          -- All virtual segments point to the same physical segment.
          uvsegd  = U.mkVSegd (U.replicate c 0) ussegd
 
-     in  PNested uvsegd (V.singleton darr)
+     in  PNested uvsegd $ singletondPR darr
   {-# NOINLINE replicatePR #-}
   --  NOINLINE because it's a cheap segment descriptor operation, 
   --  and doesn't need to fuse with anything.
@@ -238,9 +206,9 @@ instance PR a => PR (PArray a) where
   -- To index into a nested array, first determine what segment the index
   -- corresponds to, and extract that as a slice from that physical array.
   {-# INLINE_PDATA indexPR #-}
-  indexPR (PNested uvsegd pdata) ix
+  indexPR (PNested uvsegd pdatas) ix
    | (pseglen@(I# pseglen#), psegstart, psegsrcid)    <- U.getSegOfVSegd uvsegd ix
-   = let !psrc          = pdata `V.unsafeIndex` psegsrcid
+   = let !psrc          = pdatas `indexdPR` psegsrcid
          !pdata'        = extractPR psrc psegstart pseglen
      in  PArray pseglen# pdata'
 
@@ -278,10 +246,13 @@ instance PR a => PR (PArray a) where
   --           2: PInt [7,8,9,10,11,12,13,0,1,2,3,0,5,6,7,8,9,0,1,2,3]
   --
   {-# INLINE_PDATA indexlPR #-}
-  indexlPR c (PNested uvsegd pdata) (PInt ixs)
+  indexlPR (PNested uvsegd pdatas@(PNesteds arrs)) (PInt ixs)
    = let        
+         c      = U.length ixs
+   
          -- See Note: psrcoffset
-         psrcoffset     = V.prescanl (+) 0 $ V.map (V.length . pnested_psegdata) pdata
+         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 
@@ -289,7 +260,7 @@ instance PR a => PR (PArray a) where
          seginfo 
           = U.zipWith (\segid ix -> 
                         let (_,       segstart,  segsrcid)   = U.getSegOfVSegd uvsegd segid
-                            (PNested uvsegd2 _)              = pdata V.! segsrcid
+                            (PNested uvsegd2 _)              = pdatas `indexdPR` segsrcid
                             (len, start, srcid)              = U.getSegOfVSegd uvsegd2 (segstart + ix)
                         in  (len, start, srcid + (psrcoffset V.! segsrcid)))
                 (U.enumFromTo 0 (c - 1))
@@ -303,10 +274,12 @@ instance PR a => PR (PArray a) where
                         $ U.mkSSegd psegstarts' psegsrcs'
                         $ U.lengthsToSegd pseglens'
                                  
-         -- All flat data arrays in the sources go into the result.
-         psegdata'      = V.concat $ V.toList $ V.map pnested_psegdata pdata
-         
-    in  PNested uvsegd' psegdata'
+          -- All flat data arrays in the sources go into the result.
+         psegdatas'     = fromVectordPR
+                        $ V.concat $ V.toList 
+                        $ V.map (toVectordPR . pnested_psegdata) arrs
+                        
+    in  PNested uvsegd' psegdatas'
 
 
   -- To extract a range of elements from a nested array, perform the extract
@@ -349,18 +322,19 @@ instance PR a => PR (PArray a) where
   --       psrcoffset :  [0, 2]
   --
   {-# INLINE_PDATA extractsPR #-}
-  extractsPR arrs ussegd
+  extractsPR (PNesteds arrs) ussegd
    = {-# SCC "extractsPR" #-}
      let segsrcs        = U.sourcesSSegd ussegd
          segstarts      = U.startsSSegd  ussegd
          seglens        = U.lengthsSSegd ussegd
 
-         vsegids_src      = uextracts (V.map pnested_vsegids  arrs) segsrcs segstarts seglens
+         vsegids_src    = uextracts (V.map pnested_vsegids  arrs) segsrcs segstarts seglens
 
-         srcids'          = U.replicate_s (U.lengthsToSegd seglens) segsrcs
+         srcids'        = U.replicate_s (U.lengthsToSegd seglens) segsrcs
 
          -- See Note: psrcoffset
-         psrcoffset       = V.prescanl (+) 0 $ V.map (V.length . pnested_psegdata) arrs
+         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.
@@ -381,24 +355,26 @@ instance PR a => PR (PArray a) where
                 = U.unzip3 $ U.zipWith get srcids' vsegids_src
 
          -- All flat data arrays in the sources go into the result.
-         psegdata'      = V.concat $ V.toList $ V.map pnested_psegdata arrs
-   
+         psegdatas'     = fromVectordPR
+                        $ V.concat $ V.toList 
+                        $ V.map (toVectordPR . pnested_psegdata) arrs
+                   
          -- Build the result segment descriptor.
          vsegd'         = U.promoteSSegdToVSegd
                         $ U.mkSSegd psegstarts' psegsrcs'
                         $ U.lengthsToSegd pseglens'
    
-     in  PNested vsegd' psegdata'
+     in  PNested vsegd' psegdatas'
 
 
   -- Append nested arrays by appending the segment descriptors,
   -- and putting all physical arrays in the result.
   {-# INLINE_PDATA appendPR #-}
-  appendPR (PNested uvsegd1 pdata1) (PNested uvsegd2 pdata2)
+  appendPR (PNested uvsegd1 pdatas1) (PNested uvsegd2 pdatas2)
    = PNested    (U.appendVSegd
-                        uvsegd1 (V.length pdata1) 
-                        uvsegd2 (V.length pdata2))
-                (pdata1 V.++ pdata2)
+                        uvsegd1 (lengthdPR pdatas1) 
+                        uvsegd2 (lengthdPR pdatas2))
+                (pdatas1 `appenddPR` pdatas2)
 
 
   -- Performing segmented append requires segments from the physical arrays to
@@ -425,7 +401,7 @@ instance PR a => PR (PArray a) where
                                    segd2 (U.lengthsSegd ysegd)
 
      in  PNested (U.promoteSegdToVSegd segd')
-                 (V.singleton 
+                 (singletondPR 
                   $ appendsPR (U.plusSegd xsegd' ysegd')
                             xsegd' xs
                             ysegd' ys)
@@ -445,11 +421,11 @@ instance PR a => PR (PArray a) where
   -- Combine nested arrays by combining the segment descriptors, 
   -- and putting all physical arrays in the result.
   {-# INLINE_PDATA combine2PR #-}
-  combine2PR sel2 (PNested uvsegd1 pdata1) (PNested uvsegd2 pdata2)
+  combine2PR sel2 (PNested uvsegd1 pdatas1) (PNested uvsegd2 pdatas2)
    = PNested    (U.combine2VSegd sel2 
-                        uvsegd1 (V.length pdata1)
-                        uvsegd2 (V.length pdata2))
-                (pdata1 V.++ pdata2)
+                        uvsegd1 (lengthdPR pdatas1)
+                        uvsegd2 (lengthdPR pdatas2))
+                (pdatas1 `appenddPR` pdatas2)
 
 
   -- Conversions ----------------------
@@ -463,7 +439,7 @@ instance PR a => PR (PArray a) where
                 (U.lengthsSegd segd)
                 (U.indicesSegd segd)
                 (U.replicate (V.length xx) 0)
-                (V.singleton (V.foldl1 appendPR $ V.map PA.unpack xx))
+                (singletondPR (V.foldl1 appendPR $ V.map PA.unpack xx))
 
 
   {-# INLINE_PDATA toVectorPR #-}
@@ -472,6 +448,42 @@ instance PR a => PR (PArray a) where
    $ indexPR arr
 
 
+  -- PRR ----------------------------------------
+  {-# 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
+        = V.unsafeIndex vec ix
+
+  {-# INLINE_PDATA appenddPR #-}
+  appenddPR (PNesteds xs) (PNesteds ys)
+        = PNesteds $ xs V.++ ys
+
+  {-# INLINE_PDATA concatdPR #-}
+  concatdPR vecs
+        = PNesteds
+                $ V.concat $ V.toList
+                $ V.map (\(PNesteds xs) -> xs) vecs
+                                
+  {-# INLINE_PDATA fromVectordPR #-}
+  fromVectordPR vec
+        = PNesteds vec
+        
+  {-# INLINE_PDATA toVectordPR #-}
+  toVectordPR (PNesteds vec)
+        = vec
+
+
 -------------------------------------------------------------------------------
 -- | Flatten a nested array into its segment descriptor and data.
 --
@@ -513,8 +525,8 @@ concatPR' (PNested vsegd pdatas)
         -- that array directly.
         | U.isManifestVSegd   vsegd
         , U.isContiguousVSegd vsegd
-        , V.length pdatas == 1
-        = pdatas `V.unsafeIndex` 0
+        , lengthdPR pdatas == 1
+        = pdatas `indexdPR` 0
 
         -- Otherwise we have to pull all the segments through the index 
         -- space transform defined by the vsegd, which copies them
@@ -542,9 +554,38 @@ concatlPR arr
                                    (U.elementsSegd segd2)
 
    in   PNested (U.promoteSegdToVSegd segd') 
-                (V.singleton darr2)
+                (singletondPR darr2)
+
+{-# INLINE_PDATA concatlPR #-}
+
+
+-- | 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 vsegd pdatas) pdata
+ = {-# SCC "unconcatPD" #-}
+   let  
+        -- Demote the vsegd to a manifest vsegd so it contains all the segment
+        -- lengths individually without going through the vsegids.
+        !segd           = U.demoteToSegdOfVSegd vsegd
 
-{-# INLINE concatlPR #-}
+        -- 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
+
+   in   PNested vsegd' (singletondPR pdata)
+
+{-# NOINLINE unconcatPR #-}
+--  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.
 
 
 -- | Lifted append.
@@ -556,7 +597,7 @@ appendlPR  arr1 arr2
         (segd2, darr2)  = unsafeFlattenPR arr2
         segd'           = U.plusSegd segd1 segd2
    in   PNested (U.promoteSegdToVSegd segd' )
-                (V.singleton
+                (singletondPR
                  $ appendsPR segd' segd1 darr1 segd2 darr2)
 
 
@@ -575,33 +616,6 @@ unsafeTakeSegdPD (PNested vsegd _)
 {-# INLINE_PDATA unsafeTakeSegdPD #-}
 
 
--- | 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.
---
-unconcatPD :: PData (PArray a) -> PData b -> PData (PArray b)
-unconcatPD (PNested vsegd pdatas) arr
- = {-# SCC "unconcatPD" #-}
-   let  
-        -- Demote the vsegd to a manifest vsegd so it contains all the segment
-        -- lengths individually without going through the vsegids.
-        !segd           = U.demoteToSegdOfVSegd vsegd
-
-        -- 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
-
-   in   PNested vsegd' (V.singleton arr)
-
-{-# NOINLINE unconcatPD #-}
---  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.
 
 
 -- | Extract some slices from some arrays.
@@ -635,3 +649,45 @@ slicelPD (PInt sliceStarts) (PInt sliceLens) arr
 --  need to inline it to specialise it for the element type.
 
 
+
+-- Testing --------------------------------------------------------------------
+-- TODO: shift this stuff into dph-base
+validIx  :: String -> Int -> Int -> Bool
+validIx str len ix 
+        = check str len ix (ix >= 0 && ix < len)
+
+validLen :: String -> Int -> Int -> Bool
+validLen str len ix 
+        = checkLen str len ix (ix >= 0 && ix <= len)
+
+-- TODO: slurp debug flag from base 
+validBool :: String -> Bool -> Bool
+validBool str b
+        = if b  then True 
+                else error $ "validBool check failed -- " ++ str
+
+{-
+-- | Pretty print the physical representation of a nested array
+instance PprPhysical (PData a) => PprPhysical (PData (PArray a)) where
+ pprp (PNested uvsegd pdata)
+  =   text "PNested"
+  $+$ (nest 4 $ vcat 
+        $ pprp uvsegd 
+        : [ int n <> colon <> text " " <> pprp pd
+                | n  <- [0..]
+                | pd <- V.toList pdata])
+
+
+instance (PR a, PprVirtual (PData a)) => PprVirtual (PData (PArray a)) where
+ pprv arr
+  =   lbrack <> hcat (punctuate comma (map pprv $ V.toList $ toVectorPR arr)) <> rbrack
+
+     
+deriving instance Show (PData a) 
+        => Show (PData (PArray a))
+-}
+
+
+
+
+
index 17aa9b3..b911836 100644 (file)
@@ -3,20 +3,31 @@ module Data.Array.Parallel.PArray.PData.Sum2 where
 
 import Data.Array.Parallel.PArray.PData.Base
 import Data.Array.Parallel.PArray.PData.Nested
+import Data.Array.Parallel.PArray.PData.Int
 import Data.Array.Parallel.PArray.Types
 import Data.Array.Parallel.PArray.PRepr.Base
+import Data.Array.Parallel.Base                 (Tag)
 import Data.Array.Parallel.Unlifted             as U
-
+import qualified Data.Vector                    as V
+import Text.PrettyPrint
+import Prelude                                  as P
 
 -------------------------------------------------------------------------------
 data instance PData (Sum2 a b)
-        = PSum2 U.Sel2 (PData a) (PData b)
-        
-        
--- PR -------------------------------------------------------------------------
+        = PSum2  U.Sel2
+                 (PData a)
+                 (PData b)
 
+data instance PDatas (Sum2 a b)
+        = PSum2s (V.Vector U.Sel2)
+                 (PDatas Tag)
+                 (PDatas a)
+                 (PDatas b)
+
+
+-- PR -------------------------------------------------------------------------
 -- This stuff isn't implemented yet.
-nope    = error "Data.Array.Parallel.PData.Void: no PR method for Sum2"
+nope str   = error $ "Data.Array.Parallel.PData.Void: no PR method for Sum2 " ++ str
 
 
 instance (PR a, PR b) => PR (Sum2 a b)  where
@@ -26,61 +37,175 @@ instance (PR a, PR b) => PR (Sum2 a b)  where
 
   {-# INLINE_PDATA emptyPR #-}
   emptyPR
-        = nope
+        = PSum2 (U.mkSel2 U.empty U.empty 0 0 (U.mkSelRep2 U.empty)) emptyPR emptyPR
 
   {-# INLINE_PDATA nfPR #-}
   nfPR (PSum2 sel xs ys)
-        = nope
+        = sel `seq` nfPR xs `seq` nfPR ys `seq` ()
 
   {-# INLINE_PDATA lengthPR #-}
-  lengthPR _
-        = nope
+  lengthPR (PSum2 sel xs ys)
+        = U.length (U.tagsSel2 sel)
 
   {-# INLINE_PDATA replicatePR #-}
-  replicatePR _
-        = nope
+  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
-        = nope
+        = nope "replicates"
                       
   {-# INLINE_PDATA indexPR #-}
-  indexPR
-        = nope
-                
+  indexPR (PSum2 sel as bs) i
+   = let !k = U.indicesSel2 sel U.!: i
+     in  case U.tagsSel2 sel U.!: i of
+             0 -> Alt2_1 (indexPR as k)
+             _ -> Alt2_2 (indexPR bs k)
+           
   {-# INLINE_PDATA indexlPR #-}
   indexlPR 
-        = nope
+        = nope "indexl"
   
   {-# INLINE_PDATA extractPR #-}
-  extractPR 
-        = nope
+  extractPR  
+        = nope "extract"
   
   {-# INLINE_PDATA extractsPR #-}
   extractsPR 
-        = nope
+        = nope "extracts"
         
   {-# INLINE_PDATA appendPR #-}
-  appendPR
-        = nope
+  appendPR (PSum2 sel1 as1 bs1)
+           (PSum2 sel2 as2 bs2)
+    = let !sel  = U.tagsToSel2
+                $ U.tagsSel2 sel1 U.+:+ U.tagsSel2 sel2
+      in  PSum2 sel (appendPR as1 as2)
+                    (appendPR bs1 bs2)
         
   {-# INLINE_PDATA appendsPR #-}
   appendsPR
-        = nope
+        = nope "appends"
         
   {-# INLINE_PDATA packByTagPR #-}
   packByTagPR
-        = nope
+        = nope "packByTag"
   
   {-# INLINE_PDATA combine2PR #-}
   combine2PR 
-        = nope
+        = nope "combine2"
         
   {-# INLINE_PDATA fromVectorPR #-}
-  fromVectorPR 
-        = nope
+  fromVectorPR vec
+   = let tags   = V.convert $ V.map tagOfSum2 vec
+         sel2   = U.tagsToSel2 tags
+         
+         -- TODO: Fix rubbish via-lists filtering.
+         xs'    = fromVectorPR $ V.fromList $ [x | Alt2_1 x <- V.toList vec]
+         ys'    = fromVectorPR $ V.fromList $ [x | Alt2_2 x <- V.toList vec]
+         
+     in  PSum2 sel2 xs' ys'
         
   {-# INLINE_PDATA toVectorPR #-}
   toVectorPR
-        = nope
-  
\ No newline at end of file
+        = nope "toVector"
+
+  -- PRR ----------------------------------------
+  {-# INLINE_PDATA emptydPR #-}
+  emptydPR 
+        = PSum2s V.empty emptydPR emptydPR emptydPR
+
+  {-# INLINE_PDATA singletondPR #-}
+  singletondPR (PSum2 sel2 xs ys)
+        = PSum2s (V.singleton sel2)
+                 (singletondPR (PInt (U.tagsSel2 sel2)))
+                 (singletondPR xs)
+                 (singletondPR ys)
+
+  {-# INLINE_PDATA lengthdPR #-}
+  lengthdPR (PSum2s sel2s _ _ _)
+        = V.length sel2s
+
+  {-# INLINE_PDATA indexdPR #-}
+  indexdPR  (PSum2s sel2s _ xss yss) ix
+        = PSum2 (V.unsafeIndex sel2s ix)
+                (indexdPR      xss   ix)
+                (indexdPR      yss   ix)
+
+  {-# INLINE_PDATA appenddPR #-}
+  appenddPR (PSum2s sels1 tagss1 xss1 yss1)
+            (PSum2s sels2 tagss2 xss2 yss2)
+   = PSum2s (sels1  V.++        sels2)
+            (tagss1 `appenddPR` tagss2)
+            (xss1   `appenddPR` xss2)
+            (yss1   `appenddPR` yss2)
+
+  {-# INLINE_PDATA concatdPR #-}
+  concatdPR
+        = nope "concatdPR"
+                
+  -- TODO: fix rubbish via-lists conversion.
+  {-# INLINE_PDATA fromVectordPR #-}
+  fromVectordPR vec
+        = let   (sels, pdatas1, pdatas2) 
+                        = P.unzip3 
+                        $ [ (sel, pdata1, pdata2) 
+                                    | PSum2 sel pdata1 pdata2 <- V.toList vec]
+          in    PSum2s  (V.fromList sels)
+                        (PInts $ V.map U.tagsSel2 $ V.fromList sels)
+                        (fromVectordPR $ V.fromList pdatas1)
+                        (fromVectordPR $ V.fromList pdatas2)
+                
+  {-# INLINE_PDATA toVectordPR #-}
+  toVectordPR 
+        = nope "toVectordPR"
+
+
+-- 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)])
+
+
+instance ( PprPhysical (PData a)
+         , PprPhysical (PData b))
+        => PprPhysical (PData (Sum2 a b)) where
+
+ pprp (PSum2 sel pdatas1 pdatas2)
+  =   text "PSum2"
+  $+$ (nest 4 $ vcat
+        [ pprp sel
+        , text "ALTS0: " <+> pprp pdatas1
+        , text "ALTS1: " <+> pprp pdatas2])
+
+
+instance ( PprPhysical (PDatas a), PR a
+         , PprPhysical (PDatas b), PR b)
+        => PprPhysical (PDatas (Sum2 a b)) where
+
+ pprp (PSum2s sels tagss pdatas1 pdatas2)
+  =   text "PSum2s"
+  $+$ (nest 4 $ vcat
+        [ text "SELS:"          $+$ (nest 4 $ vcat $ P.map pprp $ V.toList sels)
+        , text "PDATAS1:"       $$ (nest 4 $ pprp pdatas1)
+        , text "PDATAS2:"       $$ (nest 4 $ pprp pdatas2)])
+
+
index 21f0f87..97db1b1 100644 (file)
@@ -1,7 +1,7 @@
 #include "fusion-phases.h"
 
 module Data.Array.Parallel.PArray.PData.Tuple 
-        ( PData(..)
+        ( PData(..),    PDatas(..)
         , zip,          zipPD
         , zipl,         ziplPD
         , unzip,        unzipPD
@@ -18,27 +18,10 @@ import qualified Prelude                        as P
 
 -------------------------------------------------------------------------------
 data instance PData (a, b)
-        = PTuple2 (PData a) (PData b)
+        = PTuple2  (PData a) (PData b)
 
-
--- Show -----------------------------------------------------------------------
-deriving instance (Show (PData a), Show (PData b)) 
-        => Show (PData (a, b))
-
-
-instance (PprPhysical (PData a), PprPhysical (PData b))
-        => PprPhysical (PData (a, b)) where
- pprp   (PTuple2 xs ys)
-        = text "PTuple2 " <> vcat [pprp xs, pprp ys]
-
-
-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 instance PDatas (a, b)
+        = PTuple2s (PDatas a) (PDatas b)
 
 
 -- PR -------------------------------------------------------------------------
@@ -76,11 +59,10 @@ instance (PR a, PR b) => PR (a, b) where
         = (indexPR arr1 ix, indexPR arr2 ix)
 
   {-# INLINE_PDATA indexlPR #-}
-  indexlPR c (PNested uvsegd psegdata) ixs
-   = let (xs, ys)       = V.unzip $ V.map (\(PTuple2 xs' ys') -> (xs', ys')) psegdata 
-         xsArr          = PNested uvsegd xs
-         ysArr          = PNested uvsegd ys
-     in  PTuple2  (indexlPR c xsArr ixs) (indexlPR c ysArr ixs)
+  indexlPR (PNested uvsegd (PTuple2s xs ys)) ixs
+   = let xsArr  = PNested uvsegd xs
+         ysArr  = PNested uvsegd ys
+     in  PTuple2  (indexlPR xsArr ixs) (indexlPR ysArr ixs)
 
   {-# INLINE_PDATA extractPR #-}
   extractPR (PTuple2 arr1 arr2) start len
@@ -88,9 +70,8 @@ instance (PR a, PR b) => PR (a, b) where
                   (extractPR arr2 start len)
 
   {-# INLINE_PDATA extractsPR #-}
-  extractsPR arrs ussegd
-   = let (xs, ys)       = V.unzip $ V.map (\(PTuple2 xs' ys') -> (xs', ys')) arrs
-     in  PTuple2 (extractsPR xs ussegd)
+  extractsPR (PTuple2s xs ys) ussegd
+   =    PTuple2  (extractsPR xs ussegd)
                  (extractsPR ys ussegd)
 
   {-# INLINE_PDATA appendPR #-}
@@ -124,6 +105,71 @@ instance (PR a, PR b) => PR (a, b) where
         = V.zip  (toVectorPR xs)
                  (toVectorPR ys)
 
+  -- PRR ----------------------------------------
+  {-# 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 ys)
+        = 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)
+  
+  {-# INLINE_PDATA concatdPR #-}
+  concatdPR vecs
+        = PTuple2s
+                (concatdPR $ V.map (\(PTuple2s xs ys) -> xs) vecs)
+                (concatdPR $ V.map (\(PTuple2s xs ys) -> ys) vecs)
+
+  {-# INLINE_PDATA fromVectordPR #-}
+  fromVectordPR vec
+        = error "fromVectordPR[Tuple2]: not implemented"
+
+  {-# INLINE_PDATA toVectordPR #-}
+  toVectordPR arr
+        = error "toVectordPR[Tuple2]: not implemented"
+
+
+-- 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.
+ziplPD   :: PData (PArray a) -> PData (PArray b) -> PData (PArray (a, b))
+ziplPD (PNested vsegd pdatas1) (PNested _ pdatas2)
+        = PNested vsegd (PTuple2s pdatas1 pdatas2)
+{-# INLINE_PA ziplPD #-}
+
+
+-- | 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 uvsegd (PTuple2s xsdata ysdata))
+ =      PTuple2 (PNested uvsegd xsdata)
+                (PNested uvsegd ysdata)
+{-# INLINE_PA unziplPD #-}
+
 
 -- PArray functions -----------------------------------------------------------
 -- These work on PArrays of tuples, but don't need a PA or PR dictionary.
@@ -155,37 +201,22 @@ unzipl (PArray n# pdata)
         = PArray n# $ unziplPD pdata
 
 
--- 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.
---   PROBLEM: This probably isn't O(1), though it could be dep on Vector represtation.
-ziplPD   :: PData (PArray a) -> PData (PArray b) -> PData (PArray (a, b))
-ziplPD (PNested vsegd pdatas1) (PNested _ pdatas2)
-        = PNested vsegd $ V.zipWith PTuple2 pdatas1 pdatas2
-{-# INLINE_PA ziplPD #-}
-
+-- Show -----------------------------------------------------------------------
+deriving instance (Show (PData a), Show (PData b)) 
+        => Show (PData (a, b))
 
--- | 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 #-}
 
+instance (PprPhysical (PData a), PprPhysical (PData b))
+        => PprPhysical (PData (a, b)) where
+ pprp   (PTuple2 xs ys)
+        = text "PTuple2 " <> vcat [pprp xs, pprp ys]
 
--- | Lifted unzip.
---   PROBLEM: this isn't O(1), need adaptive PDatas representation.
-{-# INLINE_PA unziplPD #-}
-unziplPD  :: PData (PArray (a, b)) -> PData (PArray a, PArray b)
-unziplPD (PNested uvsegd psegdata)
- = let  (xsdata, ysdata)        
-         = V.unzip $ V.map (\(PTuple2 xs ys) -> (xs, ys)) psegdata
-   in   PTuple2 (PNested uvsegd xsdata)
-                (PNested uvsegd ysdata)
 
+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)
 
index 0b095a1..b351ed2 100644 (file)
@@ -14,22 +14,13 @@ import Text.PrettyPrint
 data instance PData ()
         = PUnit Int
 
+data instance PDatas ()
+        = PUnits (V.Vector (PData ()))
+
 punit :: PData ()
 punit =  PUnit 0
 
 
--- Show -----------------------------------------------------------------------
-deriving instance Show (PData ())
-
-instance PprPhysical (PData ()) where
-  pprp uu
-   = text $ show uu
-
-instance PprVirtual (PData ()) where
-  pprv (PUnit n)
-   = text $ "[ () x " ++ show n ++ " ]"
-
-
 -- PR -------------------------------------------------------------------------
 instance PR () where
   {-# INLINE_PDATA validPR #-}
@@ -61,8 +52,8 @@ instance PR () where
         = ()
 
   {-# INLINE_PDATA indexlPR #-}
-  indexlPR c _ _
-        = PUnit c
+  indexlPR _ (PInt uarr)
+        = PUnit $ U.length uarr
 
   {-# INLINE_PDATA extractPR #-}
   extractPR _ _ len
@@ -97,3 +88,25 @@ instance PR () where
   toVectorPR (PUnit len)
         = V.replicate len ()
 
+  -----------------------------------------------
+  {-# INLINE_PDATA lengthdPR #-}
+  lengthdPR (PUnits pdatas)
+        = V.length pdatas
+        
+  {-# INLINE_PDATA indexdPR #-}
+  indexdPR (PUnits pdatas) ix
+        = pdatas `V.unsafeIndex` ix
+        
+
+
+-- Show -----------------------------------------------------------------------
+deriving instance Show (PData ())
+
+instance PprPhysical (PData ()) where
+  pprp uu
+   = text $ show uu
+
+instance PprVirtual (PData ()) where
+  pprv (PUnit n)
+   = text $ "[ () x " ++ show n ++ " ]"
+
index c50da27..cef7a57 100644 (file)
@@ -1,7 +1,7 @@
 #include "fusion-phases.h"
 
 module Data.Array.Parallel.PArray.PData.Void 
-        (Void, pvoid)
+        (Void, pvoid, pvoids)
 where
 import Data.Array.Parallel.PArray.PData.Base
 import Data.Array.Parallel.PArray.Types
@@ -14,10 +14,15 @@ import Data.Array.Parallel.PArray.PRepr.Base
 --   only care about the tag of the data constructor and not its argumnent.
 --
 data instance PData Void
+data instance PDatas Void
 
 pvoid :: PData Void
 pvoid   = error "Data.Array.Parallel.PData.Void"
 
+pvoids :: PDatas Void
+pvoids   = error "Data.Array.Parallel.PData.Voids"
+
+
 
 -- PR --------------------------------------------------------------------------
 nope    = error "Data.Array.Parallel.PData.Void: no PR method for void"
index 2b7a6de..1be2120 100644 (file)
@@ -1,3 +1,4 @@
+#include "fusion-phases.h"
 
 module Data.Array.Parallel.PArray.PData.Wrap where
 import Data.Array.Parallel.PArray.PData.Base
@@ -7,58 +8,130 @@ import Data.Array.Parallel.PArray.PRepr.Base
 import Data.Vector.Unboxed                      (Vector)
 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       
 
+  {-# INLINE_PDATA validPR #-}
   validPR (PWrap pdata)  
         = validPA pdata
  
+  {-# INLINE_PDATA emptyPR #-}
   emptyPR               
         = PWrap emptyPA
   
+  {-# INLINE_PDATA nfPR #-}
   nfPR (PWrap pdata)      
         = nfPA pdata
         
+  {-# INLINE_PDATA lengthPR #-}
   lengthPR (PWrap pdata)
         = lengthPA pdata
         
+  {-# INLINE_PDATA replicatePR #-}
   replicatePR n (Wrap x)
         = PWrap $ replicatePA n x
 
+  {-# INLINE_PDATA replicatesPR #-}
   replicatesPR segd (PWrap xs)
         = PWrap $ replicatesPA segd xs
 
+  {-# INLINE_PDATA indexPR #-}
   indexPR (PWrap xs) ix
         = Wrap  $ indexPA xs ix
 
-  -- PROBLEM: unwrapping isn't O(1).
-  indexlPR n (PNested vsegd pdatas) ixs
-   = let pdatas' = V.map (\(PWrap a) -> a) pdatas
-     in  PWrap (indexlPA n (PNested vsegd pdatas') ixs)
+  {-# INLINE_PDATA indexlPR #-}
+  indexlPR (PNested vsegd (PWraps pdatas)) ixs
+        = PWrap (indexlPA (PNested vsegd pdatas) ixs)
 
+  {-# INLINE_PDATA extractPR #-}
   extractPR (PWrap xs) ix n
         = PWrap $ extractPA xs ix n
         
-  -- PROBLEM: unwrapping isn't O(1).
-  extractsPR vecs ssegd
-        = PWrap $ extractsPA (V.map (\(PWrap a) -> a) vecs) ssegd
+  {-# INLINE_PDATA extractsPR #-}
+  extractsPR (PWraps pdatas) ssegd
+        = PWrap $ extractsPA pdatas ssegd
 
+  {-# 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
         
+  {-# 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
 
+  {-# INLINE_PDATA fromVectorPR #-}
   fromVectorPR vec 
         = PWrap $ fromVectorPA $ V.map unWrap vec
         
+  {-# INLINE_PDATA 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
+        
+{-
+  {-# INLINE_PDATA concatdPR #-}
+  concatdPR vecs
+        = PWraps
+                $ V.concat $ V.toList
+                $ V.map (\(PWraps xs) -> toVectordPA xs) vecs
+-}
+{-                
+  {-# INLINE_PDATA mapdPR #-}
+  mapdPR f (PDoubles uarrs)
+        = PDoubles 
+                $ V.map (\xs -> case f (PDouble xs) of 
+                                        PDouble zs' -> zs')
+                $ uarrs
+
+  {-# INLINE_PDATA zipWithdPR #-}
+  zipWithdPR f (PDoubles uarrs1) (PDoubles uarrs2)
+        = PDoubles
+                $ V.zipWith 
+                        (\xs ys -> case f (PDouble xs) (PDouble ys) of
+                                        PDouble zs' -> zs')
+                        uarrs1 uarrs2
+                                
+  {-# INLINE_PDATA fromVectordPR #-}
+  fromVectordPR vec
+        = PDoubles $ V.map (\(PDouble xs) -> xs) vec
+        
+  {-# INLINE_PDATA toVectordPR #-}
+  toVectordPR (PDoubles vec)
+        = V.map PDouble vec
+-}
\ No newline at end of file
index a4ec3d4..482e0ec 100644 (file)
@@ -1,11 +1,70 @@
+#include "fusion-phases.h"
 
 module Data.Array.Parallel.PArray.PRepr
         ( module Data.Array.Parallel.PArray.PRepr.Base
         , module Data.Array.Parallel.PArray.PRepr.Instances
         , module Data.Array.Parallel.PArray.PRepr.Nested
-        , module Data.Array.Parallel.PArray.PRepr.Tuple)
+        , module Data.Array.Parallel.PArray.PRepr.Tuple
+        , packByTagsPA
+        , mapdPA
+        , zipWithdPA)
 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
\ No newline at end of file
+import Data.Array.Parallel.PArray.PRepr.Tuple
+import Data.Array.Parallel.PArray.PData
+import Data.Array.Parallel.Base                 (Tag)
+import qualified Data.Array.Parallel.Unlifted   as U
+
+
+-- | Filter some scattered segments according to some tag arrays.
+--   The `SSegd` describes the layout of the source data as well as the tags,
+--   which must be the same.
+packByTagsPA
+        :: PA a
+        => U.SSegd
+        -> PDatas a             -- ^ Source array
+        -> PDatas Tag           -- ^ Tag arrays
+        -> Tag                  -- ^ Tag of elements to select.
+        -> (U.Segd, PData a)
+
+packByTagsPA ssegd xdatas bdatas tag
+ = let
+        -- Gather the scattered data together into contiguous arrays, 
+        -- which is the form packByTag needs.
+        xdata_contig            = extractsPA xdatas ssegd
+        bdata'@(PInt tags)      = extractsPA bdatas ssegd
+         
+        -- Pack all the psegs.
+        xdata'          = packByTagPA xdata_contig tags 1
+
+        -- Rebuild the segd to account for the possibly smaller segments.
+        segd            = U.lengthsToSegd $ U.lengthsSSegd ssegd
+  in    (segd, xdata')
+{-# INLINE_PA packByTagsPA #-}
+
+
+mapdPA  :: (PA a, PA b)
+        => (PData  a -> PData  b) 
+        ->  PDatas a -> PDatas b
+mapdPA f xs
+ = fromArrPReprs
+ $ mapdPR
+        (\x -> toArrPRepr $ f $ fromArrPRepr x)
+        (toArrPReprs xs)
+{-# INLINE_PA mapdPA #-}
+
+
+
+zipWithdPA
+        :: (PA a, PA b, PA c)
+        => (PData  a -> PData  b -> PData  c)
+        ->  PDatas a -> PDatas b -> PDatas c
+zipWithdPA f xs ys
+ = fromArrPReprs
+ $ zipWithdPR
+        (\x y -> toArrPRepr $ f (fromArrPRepr x) (fromArrPRepr y))
+        (toArrPReprs xs) (toArrPReprs ys)
+{-# INLINE_PA zipWithdPA #-}
+
index 375db49..9937a70 100644 (file)
@@ -16,21 +16,26 @@ module Data.Array.Parallel.PArray.PRepr.Base
         , emptyPA
         , nfPA
         , lengthPA
-        , replicatePA,    replicatesPA
-        , indexPA,        indexlPA
-        , extractPA,      extractsPA
-        , appendPA,       appendsPA
+        , replicatePA,  replicatesPA
+        , indexPA,      indexlPA
+        , extractPA,    extractsPA
+        , appendPA,     appendsPA
         , packByTagPA
         , combine2PA
-        , fromVectorPA,   toVectorPA)
+        , fromVectorPA, toVectorPA
+        , emptydPA
+        , singletondPA
+        , lengthdPA
+        , indexdPA
+        , appenddPA
+        , concatdPA)
 where
 import Data.Array.Parallel.PArray.PData.Base
-import Data.Vector                              (Vector)
 import Data.Array.Parallel.Base                 (Tag)
+import Data.Vector                              (Vector)
 import qualified Data.Array.Parallel.Unlifted   as U
 import qualified Data.Vector                    as V
 
-
 -- | Representable types.
 --
 --   The family of types that we know how to represent generically.
@@ -48,27 +53,16 @@ type family PRepr a
 --   representable type to and from its generic representation.
 --   The conversion 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
+  toPRepr               :: a                    -> PRepr a
+  fromPRepr             :: PRepr a              -> a
 
+  toArrPRepr            :: PData a              -> PData (PRepr a)
+  fromArrPRepr          :: PData (PRepr a)      -> PData a
 
-  -- PROBLEM: 
-  --  The new library needs these conversion functions, but the default
-  --  conversion isn't O(1). Perhaps we should be using an (Int -> PData a)
-  --  function instead of a vector, then conversion would just be 
-  --  function composition.
-  toArrPReprs           :: Vector (PData a)         -> Vector (PData (PRepr a))
-  toArrPReprs arrs
-        = V.map toArrPRepr arrs
+  toArrPReprs           :: PDatas a             -> PDatas (PRepr a)
+  fromArrPReprs         :: PDatas (PRepr a)     -> PDatas a
 
-  fromArrPReprs         :: Vector (PData (PRepr a)) -> Vector (PData a)
-  fromArrPReprs pdatas
-        = V.map fromArrPRepr pdatas
-
-  toNestedArrPRepr      :: PData (PArray a)         -> PData (PArray (PRepr a))
+  toNestedArrPRepr      :: PData (PArray a)     -> PData (PArray (PRepr a))
 
 
 -- PD Wrappers ----------------------------------------------------------------
@@ -133,10 +127,10 @@ indexPA xs i
 
 
 {-# INLINE_PA indexlPA #-}
-indexlPA        :: PA a => Int -> PData (PArray a) -> PData Int -> PData a
-indexlPA xss ixs
+indexlPA        :: PA a => PData (PArray a) -> PData Int -> PData a
+indexlPA xss ixs
  = fromArrPRepr
- $ indexlPR (toNestedArrPRepr xss) ixs
+ $ indexlPR (toNestedArrPRepr xss) ixs
 
 
 {-# INLINE_PA extractPA #-}
@@ -147,7 +141,7 @@ extractPA xs start len
 
 
 {-# INLINE_PA extractsPA #-}
-extractsPA      :: PA a => Vector (PData a) -> U.SSegd -> PData a
+extractsPA      :: PA a => PDatas a -> U.SSegd -> PData a
 extractsPA xss segd
  = fromArrPRepr
  $ extractsPR (toArrPReprs xss) segd
@@ -193,5 +187,45 @@ 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)
+
 
\ No newline at end of file
+{-# 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 concatdPA #-}
+concatdPA       :: PA a => V.Vector (PDatas a) -> PDatas a
+concatdPA vec
+ = fromArrPReprs
+ $ concatdPR (V.map toArrPReprs vec)
index ab89590..038031c 100644 (file)
@@ -1,5 +1,5 @@
 #include "fusion-phases.h"
-
+{-# LANGUAGE UndecidableInstances #-}
 -- | Instances for the PRRepr/PA family and class.
 --
 --   This module is kept separate from PRepr.Base to break an import cycle
@@ -17,7 +17,10 @@ import Data.Array.Parallel.PArray.PData.Sum2
 import Data.Array.Parallel.PArray.PData.Tuple
 import Data.Array.Parallel.PArray.PData.Int
 import Data.Array.Parallel.PArray.PData.Double
+import Data.Array.Parallel.Base                 (Tag)
 import qualified Data.Array.Parallel.Unlifted   as U
+import qualified Data.Vector                    as V
+import Text.PrettyPrint
 
 -- Void -----------------------------------------------------------------------
 type instance PRepr Void = Void
@@ -28,6 +31,7 @@ instance PA Void where
   toArrPRepr            = id
   fromArrPRepr          = id
   toArrPReprs           = id
+  fromArrPReprs         = id
   toNestedArrPRepr      = id
 
 
@@ -40,6 +44,7 @@ instance PA () where
   toArrPRepr            = id
   fromArrPRepr          = id
   toArrPReprs           = id
+  fromArrPReprs         = id
   toNestedArrPRepr      = id
 
 
@@ -52,6 +57,7 @@ instance PA Int where
   toArrPRepr            = id
   fromArrPRepr          = id
   toArrPReprs           = id
+  fromArrPReprs         = id
   toNestedArrPRepr      = id
 
 
@@ -64,20 +70,26 @@ instance PA Double where
   toArrPRepr            = id
   fromArrPRepr          = id
   toArrPReprs           = id
+  fromArrPReprs         = id
   toNestedArrPRepr      = id
   
   
 -- Bool -----------------------------------------------------------------------
--- | Bools are represented generically by just using the tag part of an
---   altenative.
-data instance PData Bool
-  = PBool U.Sel2
-
 -- | 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) (PDatas Tag)
+
+
+instance PprPhysical (PData Bool) where
+ pprp (PBool sel2) = pprp sel2
+
 instance PA Bool where
   {-# INLINE toPRepr #-}
   toPRepr False          = Alt2_1 void
@@ -88,10 +100,50 @@ instance PA Bool where
   fromPRepr (Alt2_2 _)   = True
 
   {-# INLINE toArrPRepr #-}
-  toArrPRepr (PBool sel) = PSum2 sel pvoid pvoid
+  toArrPRepr (PBool sel) 
+        = PSum2 sel pvoid pvoid
 
   {-# INLINE fromArrPRepr #-}
   fromArrPRepr (PSum2 sel _ _)
-   = PBool sel
+        = PBool sel
+
+  {-# INLINE toArrPReprs #-}
+  toArrPReprs (PBools sels tagss)
+        = PSum2s sels tagss pvoids pvoids
+
+  {-# INLINE fromArrPReprs #-}
+  fromArrPReprs (PSum2s sels tagss _ _)
+        = PBools sels tagss
+
+
+-- Either ---------------------------------------------------------------------
+type instance PRepr (Either a b)
+ = Sum2 a b
+data instance PData (Either a b)
+ = PEither U.Sel2 (PData a) (PData b)
 
-  
\ No newline at end of file
+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 toArrPRepr #-}
+  toArrPRepr (PEither sel pdatas1 pdatas2)
+        = PSum2 sel pdatas1 pdatas2
+        
+  {-# INLINE fromArrPRepr #-}
+  fromArrPRepr (PSum2 sel pdatas1 pdatas2)
+        = PEither sel pdatas1 pdatas2
+        
+instance (PprPhysical (PData a), PprPhysical (PData b), PR a, PR b)
+        => PprPhysical (PData (Either a b)) where
+ pprp xs = pprp $ toArrPRepr xs
+
\ No newline at end of file
index ee1140c..bbf357a 100644 (file)
@@ -58,7 +58,7 @@ concatPA arr
 {-# INLINE_PA unconcatPA #-}
 unconcatPA      :: (PA a, PA b) => PData (PArray a) -> PData b -> PData (PArray b)
 unconcatPA arr1 arr2
- = fromArrPRepr $ unconcatPD (toArrPRepr arr1) (toArrPRepr arr2)
+ = fromArrPRepr $ unconcatPR (toArrPRepr arr1) (toArrPRepr arr2)
 
 
 {-# INLINE_PA concatlPA #-}
index 1898318..7e18037 100644 (file)
@@ -11,10 +11,12 @@ import Data.Array.Parallel.PArray.PData.Tuple
 import Data.Array.Parallel.PArray.PData.Nested
 
 
--- Tuple2 ---------------------------------------------------------------------
+-------------------------------------------------------------------------------
 type instance PRepr (a,b)
         = (Wrap a, Wrap b)
 
+
+-- PA -------------------------------------------------------------------------
 instance (PA a, PA b) => PA (a,b) where
   {-# INLINE_PA toPRepr #-}
   toPRepr (a, b)
@@ -25,15 +27,22 @@ instance (PA a, PA b) => PA (a,b) where
         = (a, b)
 
   {-# INLINE_PA toArrPRepr #-}
-  toArrPRepr   (PTuple2 as bs)
+  toArrPRepr (PTuple2 as bs)
         = PTuple2 (PWrap as) (PWrap bs)
 
   {-# INLINE_PA fromArrPRepr #-}
   fromArrPRepr (PTuple2 (PWrap as) (PWrap bs))
         = PTuple2 as bs
 
-  -- PROBLEM: What to do here?
+  {-# INLINE_PA toArrPReprs #-}
+  toArrPReprs (PTuple2s as bs)
+        = PTuple2s (PWraps as) (PWraps bs)
+
+  {-# INLINE_PA fromArrPReprs #-}
+  fromArrPReprs (PTuple2s (PWraps as) (PWraps bs))
+        = PTuple2s as bs
+
   {-# INLINE_PA toNestedArrPRepr #-}
-  toNestedArrPRepr (PNested _vsegd _pdatas)
-        = error "Data.Array.Parallel.PArray.PRepr.Tuple: doh, what do do?"
+  toNestedArrPRepr (PNested vsegd (PTuple2s as bs))
+        = PNested vsegd (PTuple2s (PWraps as) (PWraps bs))
         
index d03ddbb..7652c1d 100644 (file)
@@ -43,8 +43,11 @@ import Prelude hiding
 -- | 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
+  fromScalarPData  :: PData  a             -> U.Array a
+  fromScalarPDatas :: PDatas a             -> V.Vector (U.Array a)
+  
+  toScalarPData    :: U.Array a            -> PData a
+  toScalarPDatas   :: V.Vector (U.Array a) -> PDatas a
 
 
 -- Shorthands for the above methods used in this module only.
@@ -64,13 +67,17 @@ instance Scalar Bool where
 
 
 instance Scalar Int where
-  fromScalarPData (PInt xs)     = xs
-  toScalarPData                 = PInt
+  fromScalarPData  (PInt  xs)     = xs
+  fromScalarPDatas (PInts xss)    = xss
+  toScalarPData                   = PInt
+  toScalarPDatas                  = PInts
 
 
 instance Scalar Double where
-  fromScalarPData (PDouble xs)  = xs
-  toScalarPData                 = PDouble
+  fromScalarPData  (PDouble xs)   = xs
+  fromScalarPDatas (PDoubles xss) = xss
+  toScalarPData                   = PDouble
+  toScalarPDatas                  = PDoubles
 
 
 -- Conversions ----------------------------------------------------------------
@@ -155,8 +162,8 @@ folds   :: Scalar a
 
 folds f z (PArray _ (PNested vsegd pdatas))
  = let  -- Grab all the flat physical arrays.
-        uarrs           = V.map fromScalarPData pdatas
+        uarrs           = fromScalarPDatas pdatas 
+        
         -- Sum up each physical segment individually.
         psegResults     = U.fold_ss f z (U.takeSSegdOfVSegd vsegd) uarrs
         
@@ -175,7 +182,7 @@ fold1s  :: Scalar a
 
 fold1s f (PArray _ (PNested vsegd pdatas))
  = let  -- Grab all the flat physical arrays.
-        uarrs           = V.map fromScalarPData pdatas
+        uarrs           = fromScalarPDatas pdatas 
  
         -- Sum up each physical segment individually.
         psegResults     = U.fold1_ss f (U.takeSSegdOfVSegd vsegd) uarrs
@@ -199,6 +206,8 @@ fold1Index f
 
 -- | 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))
@@ -229,8 +238,8 @@ enumFromTol :: PArray Int -> PArray Int -> PArray (PArray Int)
 enumFromTol (PArray m# ms) (PArray _ ns)
   = PArray m#
   $ PNested (U.promoteSegdToVSegd segd)
+  $ toScalarPDatas
   $ V.singleton
-  $ toScalarPData
   $ U.enumFromStepLenEach 
         (U.elementsSegd segd)
         (fromScalarPData ms)
index fffde9a..39e424b 100644 (file)
@@ -17,13 +17,16 @@ module Data.Array.Parallel.PArray.Types (
   fromVoid,     
 
   -- * Generic sums
-  Sum2(..),
-  Sum3(..),
+  Sum2(..), tagOfSum2,
+  Sum3(..), tagOfSum3,
 
   -- * The Wrap type
   Wrap (..)
 )
 where
+import Data.Array.Parallel.Base (Tag)
+import Data.Array.Parallel.Pretty
+
 
 -- Void -----------------------------------------------------------------------
 -- | The `Void` type is used when representing enumerations. 
@@ -49,10 +52,39 @@ fromVoid = error $unlines
          , "  should never be forced. Something has gone badly wrong." ]
 
 
--- Sums -----------------------------------------------------------------------
+-- Sum2 -----------------------------------------------------------------------
 -- | Sum types used for the generic representation of algebraic data.
-data Sum2 a b   = Alt2_1 a | Alt2_2 b
-data Sum3 a b c = Alt3_1 a | Alt3_2 b | Alt3_3 c
+data Sum2 a b
+        = Alt2_1 a | Alt2_2 b
+
+tagOfSum2 :: Sum2 a b -> Tag
+tagOfSum2 ss
+ = case ss of
+        Alt2_1 _        -> 0
+        Alt2_2 _        -> 1
+{-# INLINE tagOfSum2 #-}
+
+
+instance (PprPhysical a, PprPhysical b)
+        => PprPhysical (Sum2 a b) where
+ pprp ss
+  = case ss of
+        Alt2_1 x        -> text "Alt2_1" <+> pprp x
+        Alt2_2 y        -> text "Alt2_2" <+> pprp y
+
+
+
+-- Sum3 -----------------------------------------------------------------------
+data Sum3 a b c
+        = Alt3_1 a | Alt3_2 b | Alt3_3 c
+
+tagOfSum3 :: Sum3 a b c -> Tag
+tagOfSum3 ss
+ = case ss of
+        Alt3_1 _        -> 0
+        Alt3_2 _        -> 1
+        Alt3_3 _        -> 2
+{-# INLINE tagOfSum3 #-}
 
 
 -- Wrap -----------------------------------------------------------------------
index 0d4bf97..9462ae6 100644 (file)
@@ -19,8 +19,9 @@ module Data.Array.Parallel.VectDepend () where
 
 import Data.Array.Parallel.Lifted.Closure               ()
 import Data.Array.Parallel.Lifted.Combinators           ()
-import Data.Array.Parallel.Lifted                        ()
+import Data.Array.Parallel.Lifted                       ()
 import Data.Array.Parallel.PArray.PData.Base            ()
+import Data.Array.Parallel.PArray.PData.Bool            ()
 import Data.Array.Parallel.PArray.PData.Double          ()
 import Data.Array.Parallel.PArray.PData.Int             ()
 import Data.Array.Parallel.PArray.PData.Nested          ()
index 9ad6add..baf9c0a 100644 (file)
@@ -22,6 +22,7 @@ Library
         Data.Array.Parallel.Lifted.Combinators
         Data.Array.Parallel.Lifted
         Data.Array.Parallel.PArray.PData.Base
+        Data.Array.Parallel.PArray.PData.Bool
         Data.Array.Parallel.PArray.PData.Double
         Data.Array.Parallel.PArray.PData.Int
         Data.Array.Parallel.PArray.PData.Nested
@@ -65,6 +66,7 @@ Library
         StandaloneDeriving,
         ExplicitForAll,
         ParallelListComp,
+        PatternGuards,
         ExistentialQuantification,
         ScopedTypeVariables
         
diff --git a/dph-lifted-vseg/examples/Sums.hs b/dph-lifted-vseg/examples/Sums.hs
new file mode 100644 (file)
index 0000000..4750762
--- /dev/null
@@ -0,0 +1,18 @@
+
+module Sums where
+import qualified Data.Array.Parallel.PArray     as PA
+import Data.Array.Parallel.PArray.PRepr.Instances
+import Data.Array.Parallel.PArray.PRepr
+import Data.Array.Parallel.PArray.PData
+import Data.Array.Parallel.PArray.Types
+import qualified Data.Vector                    as V
+
+arr1 :: PArray (Either Int Int)
+arr1 = PA.fromList [Left 10, Left 20, Right 30, Left 40, Right 50 ]
+
+arr2 :: PArray (Either Int Int)
+arr2 = PA.fromList [Right 60, Right 70, Left 80 ]
+
+
+pdatas :: PDatas (Sum2 Int Int)
+pdatas = fromVectordPR (V.fromList [toArrPRepr $ unpack arr1, toArrPRepr $ unpack arr2])
\ No newline at end of file