Appends patches from Amos
authorBen Lippmeier <benl@ouroborus.net>
Mon, 30 Jul 2012 01:45:45 +0000 (11:45 +1000)
committerBen Lippmeier <benl@ouroborus.net>
Mon, 30 Jul 2012 01:45:45 +0000 (11:45 +1000)
30 files changed:
dph-base/Data/Array/Parallel/Base/TracePrim.hs
dph-lifted-vseg/Data/Array/Parallel/Lifted/Closure.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/Tuple2.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Tuple3.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Tuple4.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Tuple5.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Tuple6.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Tuple7.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/Word8.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Wrap.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PRepr/Base.hs
dph-prim-interface/Data/Array/Parallel/Unlifted.hs
dph-prim-interface/interface/DPH_Header.h
dph-prim-interface/interface/DPH_Interface.h
dph-prim-par/Data/Array/Parallel/Unlifted.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/Segmented.hs
dph-prim-seq/Data/Array/Parallel/Unlifted.hs
dph-prim-seq/Data/Array/Parallel/Unlifted/Vectors.hs
dph-test/framework/DPH/Arbitrary/Joint.hs
dph-test/framework/DPH/Arbitrary/VSegd.hs [new file with mode: 0644]
dph-test/test/PArray/PRFuns.hs
dph-test/test/Unlifted/Segmented.hs
dph-test/test/Unlifted/VSegmented.hs [new file with mode: 0644]

index f087d13..1704748 100644 (file)
@@ -78,6 +78,7 @@ data TracePrim
         | TraceReplicate_s         { traceSrcLength   :: Int }
         | TraceReplicate_rs        { traceCount       :: Int, traceSrcLength   :: Int }
         | TraceAppend_s            { traceDstLength   :: Int }
+        | TraceAppend_vs           { traceDstLength   :: Int }
         | TraceFold_s              { traceSrcLength   :: Int }
         | TraceFold1_s             { traceSrcLength   :: Int }
         | TraceFold_r              { traceSrcLength   :: Int }
index 10b35f3..bcc61b0 100644 (file)
@@ -580,7 +580,7 @@ instance PR (a :-> b) where
   -- 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"
+  appendvsPR    = dieHetroFunctions "appendsPR"
   combine2PR    = dieHetroFunctions "combine2PR"
   fromVectorPR  = dieHetroFunctions "fromVectorPR"
   appenddPR     = dieHetroFunctions "appenddPR"
index 54bc3bd..c9a4049 100644 (file)
@@ -160,9 +160,9 @@ class PR a where
   --
   --   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
+  appendvsPR    :: U.Segd
+                -> U.VSegd -> PDatas a
+                -> U.VSegd -> PDatas a
                 -> PData a
 
 
index 9f76568..5a93d79 100644 (file)
@@ -68,9 +68,9 @@ instance PR Double where
   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
+  {-# INLINE_PDATA appendvsPR #-}
+  appendvsPR segdResult segd1 (PDoubles arr1) segd2 (PDoubles arr2)
+        = PDouble $ U.append_vs segdResult segd1 arr1 segd2 arr2
 
 
   -- Projections --------------------------------                
index e9292f6..eee4035 100644 (file)
@@ -57,9 +57,9 @@ instance PR Int where
   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
+  {-# INLINE_PDATA appendvsPR #-}
+  appendvsPR segdResult segd1 (PInts arr1) segd2 (PInts arr2)
+        = PInt $ U.append_vs segdResult segd1 arr1 segd2 arr2
 
 
   -- Projections --------------------------------                
index ae12c37..61b9ccc 100644 (file)
@@ -256,36 +256,80 @@ instance PR a => PR (PArray a) where
   -- 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.
+  -- Each element of @xarr@ is a @PData (PArray a)@, and contains a vector of @PData a@.
+  -- We collect all the @PData a@s in @xarr@ and @yarr@ into one vector,
+  -- then do segmented append (@U.append_vs@) for the lengths and starts.
   --
-  {-# 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)
-                
+  -- The sources are segmented append of the input sources summed with the
+  -- scan of the length of each @PDatas a@ in @xarr@ and @yarr@,
+  -- to find the index into the concatenated source arrays.
+  {-# NOINLINE appendvsPR #-}
+  appendvsPR rsegd segd1 (PNesteds xarr) segd2 (PNesteds yarr)
+   = let 
+         -- lengths of flattened segments
+         flen           = U.lengthsSegd . takeSegdPD
+         xlens          = U.fromVectors $ V.map flen xarr
+         ylens          = U.fromVectors $ V.map flen yarr
+
+         -- scattered segment starts
+         fstart         = U.startsOfSSegd . U.takeSSegdOfVSegd . pnested_uvsegd
+         xstarts        = U.fromVectors $ V.map fstart xarr
+         ystarts        = U.fromVectors $ V.map fstart yarr
+
+         -- input sources (without sum of scan)
+         fsource        = U.sourcesOfSSegd . U.takeSSegdOfVSegd . pnested_uvsegd
+         xsources       = U.fromVectors $ V.map fsource xarr
+         ysources       = U.fromVectors $ V.map fsource yarr
+
+         -- data arrays, the result will have these concatenated
+         -- scan of lengths is used to generate new source indices
+         fdata          = toVectordPR . pnested_psegdata
+         xdata          = V.map fdata xarr
+         ydata          = V.map fdata yarr
+
+         -- why does V.concat take list, not vector?
+         ccat   = V.concatMap id
+
+         -- concatenate input data arrays
+         datas' = fromVectordPR (ccat xdata V.++ ccat ydata)
+
+         -- get data lengths to generate new source indices
+         xdatalens = V.map V.length xdata
+         ydatalens = V.map V.length ydata
+
+         -- increase each source by scan so far
+         getsrc srcs inc = U.map (+inc) srcs
+
+         -- increase x's sources by scan of lengths
+         xsrc'  = U.fromVectors $ V.zipWith getsrc (U.toVectors xsources)
+                $ V.prescanl (+) 0 xdatalens
+
+         -- increase y's sources, starting from sum of xdatalens
+         ysrc'  = U.fromVectors $ V.zipWith getsrc (U.toVectors ysources)
+                $ V.prescanl (+) (V.sum xdatalens) ydatalens
+
+
+         -- segmented append to get new sources, lengths, and starts.
+         -- TODO: would be nice if append_vs could do triples.
+         src'   = U.append_vs rsegd segd1 xsrc'
+                                    segd2 ysrc'
+
          segd'  = U.lengthsToSegd
-                $ U.append_s rsegd segd1 (U.lengthsSegd xsegd)
-                                   segd2 (U.lengthsSegd ysegd)
+                $ U.append_vs rsegd segd1 xlens
+                                    segd2 ylens
 
+         start' = U.append_vs rsegd segd1 xstarts
+                                    segd2 ystarts
 
-         -- The pdatas only contains a single flat chunk.
-         vsegd'  = U.promoteSegdToVSegd segd'
-         flat'   = appendsPR (U.plusSegd xsegd' ysegd')
-                            xsegd' xs
-                            ysegd' ys
+         -- generate vseg with new sources etc
+         vsegd' = U.promoteSSegdToVSegd
+                $ U.mkSSegd start' src' segd'
 
-         pdatas' = singletondPR flat'
+         -- lazy flattening of data
+         flat'  = extractvs_delay datas' vsegd'
+
+     in PNested vsegd' datas' segd' flat'
 
-     in  PNested vsegd' pdatas' segd' flat'
 
 
   -- Projections ------------------------------------------
@@ -651,13 +695,13 @@ unconcatPR (PNested _ _ segd _) pdata
 -- | 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
+appendlPR  arr1@(PNested vsegd1 darr1 _ _) arr2@(PNested vsegd2 darr2 _ _)
+ = let  segd1           = takeSegdPD arr1
+        segd2           = takeSegdPD arr2
         segd'           = U.plusSegd segd1 segd2
         vsegd'          = U.promoteSegdToVSegd segd'
 
-        flat'           = appendsPR segd' segd1 darr1 segd2 darr2
+        flat'           = appendvsPR segd' vsegd1 darr1 vsegd2 darr2
         pdatas'         = singletondPR flat'
    in   PNested vsegd' pdatas' segd' flat'
 {-# INLINE_PDATA appendlPR #-}
index 6f464f0..5b826b2 100644 (file)
@@ -84,10 +84,10 @@ instance (PR a, PR b) => PR (a, b) where
                   (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)
+  {-# INLINE_PDATA appendvsPR #-}
+  appendvsPR segdResult segd1 (PTuple2s arrs11 arrs12) segd2 (PTuple2s arrs21 arrs22)
+        = PTuple2 (appendvsPR segdResult segd1 arrs11 segd2 arrs21)
+                  (appendvsPR segdResult segd1 arrs12 segd2 arrs22)
 
 
   -- Projections ---------------------------------
index 1340e90..7db938f 100644 (file)
@@ -92,11 +92,11 @@ instance (PR a, PR b, PR c) => PR (a, b, c) where
                   (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)
+  {-# INLINE_PDATA appendvsPR #-}
+  appendvsPR segdResult segd1 (PTuple3s arrs11 arrs12 arrs13) segd2 (PTuple3s arrs21 arrs22 arrs23)
+        = PTuple3 (appendvsPR segdResult segd1 arrs11 segd2 arrs21)
+                  (appendvsPR segdResult segd1 arrs12 segd2 arrs22)
+                  (appendvsPR segdResult segd1 arrs13 segd2 arrs23)
 
 
   -- Projections ---------------------------------
index deee98f..6d7b405 100644 (file)
@@ -102,13 +102,13 @@ instance (PR a, PR b, PR c, PR d) => PR (a, b, c, d) where
                   (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)
+  {-# INLINE_PDATA appendvsPR #-}
+  appendvsPR segdResult segd1 (PTuple4s arrs11 arrs12 arrs13 arrs14)
+                       segd2 (PTuple4s arrs21 arrs22 arrs23 arrs24)
+        = PTuple4 (appendvsPR segdResult segd1 arrs11 segd2 arrs21)
+                  (appendvsPR segdResult segd1 arrs12 segd2 arrs22)
+                  (appendvsPR segdResult segd1 arrs13 segd2 arrs23)
+                  (appendvsPR segdResult segd1 arrs14 segd2 arrs24)
 
 
   -- Projections ---------------------------------
index 815c1d6..9c4e0ed 100644 (file)
@@ -109,14 +109,14 @@ instance (PR a, PR b, PR c, PR d, PR e) => PR (a, b, c, d, e) where
                   (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)
+  {-# INLINE_PDATA appendvsPR #-}
+  appendvsPR segdResult segd1 (PTuple5s arrs11 arrs12 arrs13 arrs14 arrs15)
+                       segd2 (PTuple5s arrs21 arrs22 arrs23 arrs24 arrs25)
+        = PTuple5 (appendvsPR segdResult segd1 arrs11 segd2 arrs21)
+                  (appendvsPR segdResult segd1 arrs12 segd2 arrs22)
+                  (appendvsPR segdResult segd1 arrs13 segd2 arrs23)
+                  (appendvsPR segdResult segd1 arrs14 segd2 arrs24)
+                  (appendvsPR segdResult segd1 arrs15 segd2 arrs25)
 
 
   -- Projections ---------------------------------
index 01ea877..85c67a2 100644 (file)
@@ -117,15 +117,15 @@ instance (PR a, PR b, PR c, PR d, PR e, PR f) => PR (a, b, c, d, e, f) where
                   (arr16 `appendPR` arr26) 
 
 
-  {-# INLINE_PDATA appendsPR #-}
-  appendsPR segdResult segd1 (PTuple6 arrs11 arrs12 arrs13 arrs14 arrs15 arrs16)
-                       segd2 (PTuple6 arrs21 arrs22 arrs23 arrs24 arrs25 arrs26)
-        = PTuple6 (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)
-                  (appendsPR segdResult segd1 arrs16 segd2 arrs26)
+  {-# INLINE_PDATA appendvsPR #-}
+  appendvsPR segdResult segd1 (PTuple6s arrs11 arrs12 arrs13 arrs14 arrs15 arrs16)
+                       segd2 (PTuple6s arrs21 arrs22 arrs23 arrs24 arrs25 arrs26)
+        = PTuple6 (appendvsPR segdResult segd1 arrs11 segd2 arrs21)
+                  (appendvsPR segdResult segd1 arrs12 segd2 arrs22)
+                  (appendvsPR segdResult segd1 arrs13 segd2 arrs23)
+                  (appendvsPR segdResult segd1 arrs14 segd2 arrs24)
+                  (appendvsPR segdResult segd1 arrs15 segd2 arrs25)
+                  (appendvsPR segdResult segd1 arrs16 segd2 arrs26)
 
 
   -- Projections ---------------------------------
index 7c2026d..1057e0c 100644 (file)
@@ -133,16 +133,16 @@ instance (PR a, PR b, PR c, PR d, PR e, PR f, PR g) => PR (a, b, c, d, e, f, g)
                   (arr17 `appendPR` arr27) 
 
 
-  {-# INLINE_PDATA appendsPR #-}
-  appendsPR segdResult segd1 (PTuple7 arrs11 arrs12 arrs13 arrs14 arrs15 arrs16 arrs17)
-                       segd2 (PTuple7 arrs21 arrs22 arrs23 arrs24 arrs25 arrs26 arrs27)
-        = PTuple7 (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)
-                  (appendsPR segdResult segd1 arrs16 segd2 arrs26)
-                  (appendsPR segdResult segd1 arrs17 segd2 arrs27)
+  {-# INLINE_PDATA appendvsPR #-}
+  appendvsPR segdResult segd1 (PTuple7s arrs11 arrs12 arrs13 arrs14 arrs15 arrs16 arrs17)
+                       segd2 (PTuple7s arrs21 arrs22 arrs23 arrs24 arrs25 arrs26 arrs27)
+        = PTuple7 (appendvsPR segdResult segd1 arrs11 segd2 arrs21)
+                  (appendvsPR segdResult segd1 arrs12 segd2 arrs22)
+                  (appendvsPR segdResult segd1 arrs13 segd2 arrs23)
+                  (appendvsPR segdResult segd1 arrs14 segd2 arrs24)
+                  (appendvsPR segdResult segd1 arrs15 segd2 arrs25)
+                  (appendvsPR segdResult segd1 arrs16 segd2 arrs26)
+                  (appendvsPR segdResult segd1 arrs17 segd2 arrs27)
 
   -- Projections ---------------------------------
   {-# INLINE_PDATA lengthPR #-}
index 04cbbb5..09ff2d4 100644 (file)
@@ -70,8 +70,8 @@ instance PR () where
   appendPR (PUnit len1) (PUnit len2)
         = PUnit (len1 + len2)
 
-  {-# INLINE_PDATA appendsPR #-}
-  appendsPR segdResult _ _ _ _
+  {-# INLINE_PDATA appendvsPR #-}
+  appendvsPR segdResult _ _ _ _
         = PUnit (U.lengthSegd segdResult)
 
 
index 8857624..f31a99f 100644 (file)
@@ -77,8 +77,8 @@ instance PR Void where
   {-# INLINE_PDATA appendPR #-}
   appendPR      = nope "append"
   
-  {-# INLINE_PDATA appendsPR #-}
-  appendsPR     = nope "appends"
+  {-# INLINE_PDATA appendvsPR #-}
+  appendvsPR     = nope "appendvs"
 
 
   -- Projections --------------------------------
index 05deaa7..b7a44fc 100644 (file)
@@ -65,9 +65,9 @@ instance PR Word8 where
   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
+  {-# INLINE_PDATA appendvsPR #-}
+  appendvsPR segdResult segd1 (PWord8s arr1) segd2 (PWord8s arr2)
+        = PWord8 $ U.append_vs segdResult segd1 arr1 segd2 arr2
 
 
   -- Projections --------------------------------                
index bda9599..90f0da9 100644 (file)
@@ -62,8 +62,8 @@ instance PA a => PR (Wrap a) where
   appendPR (PWrap xs) (PWrap ys)
         = PWrap $ appendPA xs ys
         
-  {-# INLINE_PDATA appendsPR #-}
-  appendsPR segdResult segd1 (PWrap xs) segd2 (PWrap ys)
+  {-# INLINE_PDATA appendvsPR #-}
+  appendvsPR segdResult segd1 (PWraps xs) segd2 (PWraps ys)
         = PWrap $ appendsPA segdResult segd1 xs segd2 ys
         
 
index 772f072..022b894 100644 (file)
@@ -170,11 +170,11 @@ appendPA xs ys
 
 
 {-# INLINE_PA appendsPA #-}
-appendsPA       :: PA a => U.Segd -> U.Segd -> PData a -> U.Segd 
-                        -> PData a -> PData a
+appendsPA       :: PA a => U.Segd -> U.VSegd -> PDatas a -> U.VSegd 
+                        -> PDatas a -> PData a
 appendsPA segdResult segd1 xs segd2 ys
  = fromArrPRepr
- $ appendsPR segdResult segd1 (toArrPRepr xs) segd2 (toArrPRepr ys)
+ $ appendvsPR segdResult segd1 (toArrPReprs xs) segd2 (toArrPReprs ys)
 
 
 -- Projections ----------------------------------
index 30656d2..5360106 100644 (file)
@@ -42,6 +42,7 @@ type Array a    = [a]
 empty                           = notImplemented "empty"
 (+:+)                           = notImplemented "(+:+)"
 append_s                        = notImplemented "append_s"
+append_vs                       = notImplemented "append_vs"
 replicate                       = notImplemented "replicate"
 replicate_s                     = notImplemented "replicate_s"
 replicate_rs                    = notImplemented "replicate_rs"
index 57f0f03..417a656 100644 (file)
@@ -11,7 +11,8 @@ module Data.Array.Parallel.Unlifted (
   replicate, replicate_s, replicate_rs,
   repeat,
   indexed,
-  (+:+),     append_s,
+  (+:+),
+  append_s, append_vs,
   indices_s,
   enumFromTo,
   enumFromThenTo,
index 3125377..eb7bd7c 100644 (file)
@@ -173,6 +173,17 @@ append_s
 
   #-}
 
+append_vs 
+        :: (Elt a, Elts a)
+        => Segd         -- ^ Segment descriptor of result aarray.
+        -> VSegd        -- ^ Segment descriptor of first array.
+        -> Arrays a     -- ^ Data of first array.
+        -> VSegd        -- ^ Segment descriptor of second array.
+        -> Arrays a     -- ^ Data of second array.
+        -> Array a
+{-# INLINE_BACKEND append_vs #-}
+
+
 
 -- Indexed ----------------------------
 -- | O(length result). Tag each element of an array with its index.
index b40c4cb..8bb3257 100644 (file)
@@ -62,6 +62,10 @@ append_s segd xd xs yd ys
  = let  arr     = appendSUP segd xd xs yd ys
    in   tracePrim (TraceAppend_s (Seq.length arr)) arr
 
+append_vs segd xd xs yd ys
+ = let  arr     = appendSUPV segd xd xs yd ys
+   in   tracePrim (TraceAppend_vs (Seq.length arr)) arr
+
 replicate n val 
         =  tracePrim (TraceReplicate n)
         $! replicateUP n val
index 0a5cbbc..f5955f0 100644 (file)
@@ -43,6 +43,7 @@ module Data.Array.Parallel.Unlifted.Parallel
           -- * Segmented
         , replicateRSUP
         , appendSUP
+        , appendSUPV
         , foldRUP
         , sumRUP
 
index a54b36b..dffdb3f 100644 (file)
@@ -226,9 +226,9 @@ appendUPVSegS !xd !xs !yd !ys !n seg_off el_off
 
     -- get physical segment id
     {-#INLINE xpseg #-}
-    xpseg s = xvsegs `index1` s
+    xpseg s = index1 xvsegs "xpseg" s
     {-#INLINE ypseg #-}
-    ypseg s = yvsegs `index1` s
+    ypseg s = index1 yvsegs "ypseg" s
 
     !xseglens = USegd.takeLengths xsegd
     !yseglens = USegd.takeLengths ysegd
@@ -241,9 +241,9 @@ appendUPVSegS !xd !xs !yd !ys !n seg_off el_off
 
     -- physical lengths
     {-#INLINE xplen #-}
-    xplen s = xseglens `index1` (xsrc `index1` xpseg s)
+    xplen s = index1 xseglens "xplen1" (xpseg s)
     {-#INLINE yplen #-}
-    yplen s = yseglens `index1` (ysrc `index1` ypseg s)
+    yplen s = index1 yseglens "yplen1" (ypseg s)
 
     -- get actual data
     {-# INLINE gdata #-}
@@ -251,18 +251,23 @@ appendUPVSegS !xd !xs !yd !ys !n seg_off el_off
               = let !src  = avs_ssrc     st
                     !strt = avs_sstart   st
                     !ix   = avs_index    st
-                in  Vs.unsafeIndex2 gs (I# src) (I# (strt +# ix))
+                in  index2 gs (I# src) (I# (strt +# ix))
 
     -- get scattered segment source and starts
     {-# INLINE getscatter #-}
     getscatter gpseg gsrcs gstrts segid
               = let !phys = gpseg segid                                  in
-                let !src  = gsrcs  `index1` phys                         in
-                let !strt = gstrts `index1` phys                         in
-                    (phys,src, strt)
+                let !src  = index1 gsrcs  "src" phys                         in
+                let !strt = index1 gstrts "strt" phys                         in
+                    (src, strt)
 
     {-# INLINE index1 #-}
-    index1 v i = Seq.index (here "appendUVSegS") v i
+    --index1 v i = Seq.index (here "appendUVSegS") v i
+
+    index1 v h i = Seq.index (here $ "appendUVSegS:" Prelude.++ h) v i
+
+    {-# INLINE index2 #-}
+    index2 v i1 i2 = Vs.index2 (here "appendUVSegS") v i1 i2
 
 
     {-# INLINE unbox #-}
@@ -281,7 +286,7 @@ appendUPVSegS !xd !xs !yd !ys !n seg_off el_off
 
       -- Start returning data from xs
       | el_off < xplen seg_off
-      = let (phys,src,strt) = getscatter xpseg xsrc xstrt seg_off
+      = let (src,strt)      = getscatter xpseg xsrc xstrt seg_off
             swap            = (xplen seg_off) - el_off
         in  ASUPVDo
             -- start reading from xs, then read from ys at end of this xs segment
@@ -295,7 +300,7 @@ appendUPVSegS !xd !xs !yd !ys !n seg_off el_off
 
       -- Start with ys
       | otherwise
-      = let (phys,src,strt) = getscatter ypseg ysrc ystrt seg_off
+      = let (src,strt)      = getscatter ypseg ysrc ystrt seg_off
             el_off'         = el_off        - xplen seg_off
             swap            = (yplen seg_off) - el_off'
         in  ASUPVDo
@@ -315,7 +320,7 @@ appendUPVSegS !xd !xs !yd !ys !n seg_off el_off
       -- Done reading xs, so read the rest of this segment from ys.
       | avs_next_swap s  ==# 0#  =
         let     seg'            = I# (avs_seg_off s)
-                (phys,src,strt) = getscatter ypseg ysrc ystrt seg'
+                (src,strt)      = getscatter ypseg ysrc ystrt seg'
         in      return $ Skip $
                 s {
                   avs_takefrom  = 1#
@@ -331,7 +336,7 @@ appendUPVSegS !xd !xs !yd !ys !n seg_off el_off
       -- Done reading ys, so we need to look at the next segment's xs
       | avs_next_swap s  ==# 0#
       = let     seg'            = I# (avs_seg_off s +# 1#)
-                (phys,src,strt) = getscatter xpseg xsrc xstrt seg'
+                (src,strt)      = getscatter xpseg xsrc xstrt seg'
         in      return $ Skip $
                 s {
                   avs_takefrom  = 0#
@@ -361,7 +366,6 @@ data AppendUPVState
         , avs_ssrc     :: Int#   -- ^ scattered segment source
         }
 
-
 -- Append ---------------------------------------------------------------------
 -- | Segmented append.
 -- -old
index f4ce05b..a5e9870 100644 (file)
@@ -34,7 +34,13 @@ type Array                      = U.Vector
 -- Constructors ---------------------------------------------------------------
 empty                           = U.empty
 (+:+)                           = (U.++)
-append_s _                      = appendSU
+append_s _ xd xs yd ys          = appendSU xd xs yd ys
+append_vs _ xd xs yd ys         = appendSU xd' xs' yd' ys'
+ where  xd' = unsafeDemoteToSegdOfVSegd xd
+        yd' = unsafeDemoteToSegdOfVSegd yd
+        xs' = extractsFromVectorsUVSegd xd xs
+        ys' = extractsFromVectorsUVSegd yd ys
+
 replicate                       = U.replicate
 replicate_s                     = replicateSU
 replicate_rs                    = replicateRSU
index c234546..0fe74cf 100644 (file)
@@ -16,6 +16,8 @@ module Data.Array.Parallel.Unlifted.Vectors
         , empty
         , singleton
         , length
+        , index
+        , index2
         , unsafeIndex
         , unsafeIndex2
         , unsafeIndexUnpack
@@ -23,6 +25,7 @@ module Data.Array.Parallel.Unlifted.Vectors
         , fromVector
         , toVector)
 where
+import qualified Data.Array.Parallel.Base       as B
 import qualified Data.Array.Parallel.Unlifted.ArrayArray as AA
 import qualified Data.Primitive.ByteArray                as P
 import qualified Data.Primitive.Types                    as P
@@ -116,6 +119,15 @@ unsafeIndex (Vectors _ starts lens arrs) ix
         R.unsafeFreeze mvec
 {-# INLINE_U unsafeIndex #-}
 
+-- | Take one of the outer vectors from a `Vectors`, with bounds checking
+index   :: (Unboxes a, Unbox a)
+        => String -- ^ source position
+        -> Vectors a -> Int -> U.Vector a
+index here vec ix
+        = B.check here (length vec) ix
+        $ unsafeIndex  vec ix
+{-# INLINE_U index #-}
+
 
 -- | Retrieve a single element from a `Vectors`, 
 --   given the outer and inner indices.
@@ -124,6 +136,17 @@ unsafeIndex2 (Vectors _ starts _ arrs) ix1 ix2
  = (arrs `AA.indexArrayArray` ix1) `P.indexByteArray` ((starts `P.indexByteArray` ix1) + ix2)
 {-# INLINE_U unsafeIndex2 #-}
 
+-- | Retrieve a single element from a `Vectors`, 
+--   given the outer and inner indices, with bounds checking.
+index2  :: Unboxes a
+        => String -- ^ source position
+        -> Vectors a -> Int -> Int -> a
+index2 here vec@(Vectors _ _ lens _) ix1 ix2
+        = B.check (here++"(index2.ix1)") (length vec) ix1
+        $ B.check (here++"(index2.ix2)") (lens `P.indexByteArray` ix1) ix2
+        $ unsafeIndex2 vec ix1 ix2
+{-# INLINE_U index2 #-}
+
 
 -- | Retrieve an inner array from a `Vectors`, returning the array data, 
 --   starting index in the data, and vector length.
index 0a32c55..7ec4aee 100644 (file)
@@ -65,3 +65,40 @@ instance (PprPhysical a, PprPhysical b) => PprPhysical (Joint22 a b) where
 instance (PprVirtual a,  PprVirtual b)  => PprVirtual  (Joint22 a b) where
  pprv (Joint22 x y)
         = text "Joint22" <+> parens (pprv x) <+> parens (pprv y)
+
+-- Joint2N ---------------------------------------------------------------------
+-- | Generate two nested arrays with the same lengths at the outermost level.
+--   Also adjust the length of the inner elements, so the the total
+--   number of elements is proportional to the size parameter.
+data Joint2n a b
+        = Joint2n a b
+        deriving Show
+
+instance ( Array c11 (c12 a), Array c12 a, Arbitrary a
+         , Array c21 (c22 b), Array c22 b, Arbitrary b)
+        => Arbitrary (Joint2n (c11 (c12 a)) (c21 (c22 b))) where
+
+ arbitrary
+  = sized $ \s ->
+  do    let s'   =  truncate $ sqrt $ fromIntegral s
+
+        lens1    <- liftM (map (\(NonNegative n) -> n)) 
+                 $  listOf $ resize s' arbitrary
+        -- for each element in first lengths, generate list with new number
+        lens2    <- mapM (\_ -> do
+                NonNegative n <- resize s' arbitrary
+                return n
+                ) lens1
+
+        xs      <- liftM (fromList . map fromList) $ mapM vector lens1
+        ys      <- liftM (fromList . map fromList) $ mapM vector lens2
+        return  $ Joint2n xs ys
+
+
+instance (PprPhysical a, PprPhysical b) => PprPhysical (Joint2n a b) where
+ pprp (Joint2n x y)
+        = vcat [text "Joint2n", nest 4 $ pprp x, nest 4 $ pprp y]
+
+instance (PprVirtual a,  PprVirtual b)  => PprVirtual  (Joint2n a b) where
+ pprv (Joint2n x y)
+        = text "Joint2n" <+> parens (pprv x) <+> parens (pprv y)
diff --git a/dph-test/framework/DPH/Arbitrary/VSegd.hs b/dph-test/framework/DPH/Arbitrary/VSegd.hs
new file mode 100644 (file)
index 0000000..eba31ee
--- /dev/null
@@ -0,0 +1,117 @@
+
+-- | Generation of arbitrary segment descriptors.
+module DPH.Arbitrary.VSegd
+        ( pdatasForVSegd
+        , pdataForVSegd
+        , arraysForVSegd
+        , vsegdOfLength
+        )
+where
+import Test.QuickCheck
+import Data.Array.Parallel.Unlifted as U hiding ( update )
+import Data.List
+import Prelude as P
+
+import qualified Data.Array.Parallel.PArray.PData        as PD
+import qualified Data.Array.Parallel.PArray.PData.Nested as PDN
+
+import qualified Data.Vector as V
+
+import Debug.Trace
+
+
+instance Arbitrary VSegd where
+  arbitrary = sized vsegdOfLength
+
+-- | Generate a virtual segment descriptor with @len@ elements in vsegmap, ie logical data is @len@-long.
+vsegdOfLength :: Int -> Gen VSegd
+vsegdOfLength len
+ = sized $ \size -> do
+        -- stop data getting too big
+        let smaller = truncate $ sqrt $ fromIntegral size
+        let len' = max 1 len
+
+        -- number of elements in flattened data
+        NonNegative n' <- resize smaller arbitrary
+        let n = max 1 n'
+
+        -- indices
+        ids <- inrange n (len'-1)
+        let ids' = 0 : sort ids
+
+        -- flat segment descriptor
+        let lens = indicesToLengths ids' n
+        let segd = mkSegd (fromList lens) (fromList ids') n
+
+        -- virtual segment map and starts
+        vsegs  <- inrange len' len'
+        starts <- inrange len' len'
+
+        -- choose maximum number of source arrays
+        NonNegative nsrc' <- resize smaller arbitrary
+        let nsrc = max 1 nsrc'
+        sources <- inrange nsrc len'
+
+        let ssegd = mkSSegd (fromList starts) (fromList sources) segd
+        return $ mkVSegd (fromList vsegs) ssegd
+ where 
+        indicesToLengths ids n = P.zipWith (-) (tail $ ids ++ [n]) ids
+
+        inrange n len = P.map (`mod` n) `fmap` vector len
+
+-- | Generate some data for a given virtual segment descriptor, eg for use with append_vs.
+-- Takes a phantom/unused argument of type @a@ to make tests easier..
+arraysForVSegd :: (Arbitrary a, Elt a, Elts a) => VSegd -> a -> Gen (Arrays a)
+arraysForVSegd vsegd _
+ = do   d <- mapM pdata [0..maxsrc]
+        return $ fromVectors $ V.fromList d
+ where
+        vsegids = toList $ U.takeVSegidsOfVSegd  vsegd
+        ssegd   =          U.takeSSegdOfVSegd    vsegd
+        starts  = toList $ U.startsOfSSegd       ssegd
+        sources = toList $ U.sourcesOfSSegd      ssegd
+        lens    = toList $ U.lengthsOfSSegd      ssegd
+
+        maxsrc    = maxo sources
+        ends    = P.zipWith (+) starts lens
+
+        maxo xs | null xs       = 0
+                | otherwise     = maximum xs
+
+        pdata n = do
+                let minlen = maxo $ P.map fst $ P.filter ((==n).snd) $ P.zip ends sources
+                v <- vector minlen
+                return $ fromList v
+
+-- | Generate PDatas for a given virtual segment descriptor, eg for use with appendlPR
+-- Takes a phantom/unused argument of type @a@ to make tests easier..
+pdatasForVSegd :: (Arbitrary a, PD.PR a) => VSegd -> a -> Gen (PD.PDatas a)
+pdatasForVSegd vsegd _
+ = do   d <- mapM pdata [0..maxsrc]
+        return $ PD.fromVectordPR $ V.fromList d
+ where
+        vsegids = toList $ U.takeVSegidsOfVSegd  vsegd
+        ssegd   =          U.takeSSegdOfVSegd    vsegd
+        starts  = toList $ U.startsOfSSegd       ssegd
+        sources = toList $ U.sourcesOfSSegd      ssegd
+        lens    = toList $ U.lengthsOfSSegd      ssegd
+
+        maxsrc    = maxo sources
+        ends    = P.zipWith (+) starts lens
+
+        maxo xs | null xs       = 0
+                | otherwise     = maximum xs
+
+        pdata n = do
+                let minlen = maxo $ P.map fst $ P.filter ((==n).snd) $ P.zip ends sources
+                v <- vector minlen
+                return $ PD.fromVectorPR $ V.fromList v
+
+pdataForVSegd :: (Arbitrary a, PD.PR a) => VSegd -> a -> Gen (PD.PData (PD.PArray a))
+pdataForVSegd vsegd phantom = do
+    pdatas <- pdatasForVSegd vsegd phantom
+    let segd' = U.unsafeDemoteToSegdOfVSegd vsegd
+    let flat' = PDN.extractvs_delay pdatas vsegd
+    return $ PDN.mkPNested vsegd pdatas segd' flat'
+
+
index 757fc5d..0f17c2a 100644 (file)
@@ -32,6 +32,8 @@ import qualified DPH.Operators.List             as L
 import System.IO.Unsafe
 import Debug.Trace
 
+import DPH.Arbitrary.VSegd
+
 -- NOTE:
 -- The 'b' element type contains one less level of nesting compared with the
 -- 'a' type. We use 'b' when we're checking properties of functions that
@@ -295,18 +297,42 @@ $(testcases [ ""        <@ [t|  PArray Int |]
      in   validPR pdata'' && toVectors2 pdata == toVectors2 pdata''
 
 
-  -- TODO: Joint22 requires second level lengths to be the same, but this isn't nessesary.
-  --       Want to allow this to vary, while still constraining level size.
   -- | Lifted append
   prop_appendl
         :: (PR b, PA b, Eq b)
-        => Joint22 (PData (PArray b)) (PData (PArray b)) ->  Bool
-  prop_appendl (Joint22 pdata1 pdata2)
+        => Joint2n (PData (PArray b)) (PData (PArray b)) ->  Bool
+  prop_appendl (Joint2n pdata1 pdata2)
    = let vec'   = V.zipWith (V.++) (toVectors2 pdata1) (toVectors2 pdata2)
          pdata' = appendlPR pdata1 pdata2 
 
      in  validPR pdata'  && vec' == toVectors2 pdata'
 
+  -- | Lifted append, but with more interesting kinds of data (more sharing, separate sources, etc)
+  prop_appendlV
+        :: (PR b, PA b, Eq b, Arbitrary b, Show b, Show (PData b), Show (PDatas b))
+        => b -> Property
+  prop_appendlV phantom
+   = forAll (sized (\n -> return n)) $ \len ->
+     forAll (vsegdOfLength len) $ \segd1 ->
+     forAll (pdataForVSegd segd1 phantom) $ \pdata1 ->
+     forAll (vsegdOfLength len) $ \segd2 ->
+     forAll (pdataForVSegd segd2 phantom) $ \pdata2 ->
+
+     let vec'   = V.zipWith (V.++) (toVectors2 pdata1) (toVectors2 pdata2)
+         pdata' = appendlPR pdata1 pdata2 
+
+     in  validPR pdata'  && vec' == toVectors2 pdata'
+
+  prop_fromvec1 :: Vector Int -> Bool
+  prop_fromvec1 pdata
+   = let vec'   = toVector $ (fromVector pdata :: PData Int)
+     in  vec' == pdata
+
+  prop_fromvec2 :: Vector (PArray Int) -> Bool
+  prop_fromvec2 pdata
+   = let vec'   = toVector $ (fromVector pdata :: PData (PArray Int))
+     in  vec' == pdata
+
 
   ---------------------------------------------------------
   -- TODO: slicelPD
index 2befc3c..d491e92 100644 (file)
@@ -31,14 +31,14 @@ $(testcases [ ""        <@ [t| ( Bool, Int ) |]
             arr' = toList arr
 
     -- compute sum of each segment
-    prop_sum_s :: (Num num, Elt num) => Array num -> Property
+    prop_sum_s :: (Eq num, Num num, Elt num) => Array num -> Property
     prop_sum_s arr = forAll (segdForArray arr) $ \segd ->
       let lens' = toList $ lengthsSegd segd
           arr'  = toList $ arr
       in toList (sum_s segd arr) == P.map P.sum (nest lens' arr')
 
     -- compute sum of each (complete) sequence of @n@ elements
-    prop_sum_r :: (Num num, Elt num) => SizedInt -> Array num -> Property
+    prop_sum_r :: (Eq num, Num num, Elt num) => SizedInt -> Array num -> Property
     prop_sum_r (SizedInt n) arr =
       n > 0 -- other cases are not (yet) handled
       ==> toList (sum_r n arr) == P.map P.sum (arr' `nestBy` n)
@@ -59,7 +59,9 @@ $(testcases [ ""        <@ [t| ( Bool, Int ) |]
           lens2' = toList lens2
           arr'   = toList arr
           brr'   = toList brr
-      in toList (append_s (segdFrom lens1 lens2) segd1 arr segd2 brr) ==
+      in 
+         P.length lens1' == P.length lens2' ==>
+         toList (append_s (segdFrom lens1 lens2) segd1 arr segd2 brr) ==
          concat (interleave (nest lens1' arr') (nest lens2' brr'))
       where segdFrom lens1 lens2 = lengthsToSegd $ U.interleave lens1 lens2
             lengthsToSegd lens = mkSegd lens (scan (+) 0 lens) (U.sum lens)
diff --git a/dph-test/test/Unlifted/VSegmented.hs b/dph-test/test/Unlifted/VSegmented.hs
new file mode 100644 (file)
index 0000000..f131bb5
--- /dev/null
@@ -0,0 +1,43 @@
+import DPH.Testsuite
+import DPH.Arbitrary.Segd
+import DPH.Arbitrary.VSegd
+import DPH.Arbitrary.Int
+import Data.Array.Parallel.Unlifted as U
+import Prelude as P
+
+import qualified Data.Vector                             as V
+import qualified Data.Array.Parallel.PArray.PData        as PD
+import qualified Data.Array.Parallel.PArray.PData.Nested as PDN
+
+import Debug.Trace
+
+$(testcases [ ""        <@ [t| ( Int, Float, Double ) |]
+            ]
+  [d|
+    -- interleaves the segments of two arrays, e.g.:
+    -- append_s (Segd [1,1,2,1]) (Segd [1,2]) [1,3,4] (Segd [1,1]) [2,5]
+    --   = [1,2,3,4,5]
+    prop_append_vs :: (Eq a, Elt a, Elts a, Arbitrary a, Show a) => a -> Property
+    prop_append_vs phantom =
+      forAll (sized (\n -> return n)) $ \len ->
+      forAll (vsegdOfLength len) $ \segd1 ->
+      forAll (arraysForVSegd segd1 phantom) $ \arr ->
+      forAll (vsegdOfLength len) $ \segd2 ->
+      forAll (arraysForVSegd segd2 phantom) $ \brr ->
+      let lens1  = takeLengthsOfVSegd segd1
+          lens2  = takeLengthsOfVSegd segd2
+          lens1' = toList lens1
+          lens2' = toList lens2
+          arr'   = toList $ extracts_avs segd1 arr
+          brr'   = toList $ extracts_avs segd2 brr
+      in 
+         P.length lens1' == P.length lens2' ==>
+         toList (append_vs (segdFrom lens1 lens2) segd1 arr segd2 brr) ==
+         concat (interleave (nest lens1' arr') (nest lens2' brr'))
+      where segdFrom lens1 lens2 = lengthsToSegd $ U.interleave lens1 lens2
+            lengthsToSegd lens = mkSegd lens (scan (+) 0 lens) (U.sum lens)
+            interleave (x : xs) (y : ys) = x : y : interleave xs ys
+            interleave (x : xs) _        = [x]
+            interleave _        _        = []
+  |])
+