dph-prim-par: Add justifications to foldD and scanD
authorBen Lippmeier <benl@ouroborus.net>
Mon, 23 Jul 2012 07:02:35 +0000 (17:02 +1000)
committerBen Lippmeier <benl@ouroborus.net>
Mon, 30 Jul 2012 03:48:35 +0000 (13:48 +1000)
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Arrays.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Data/Bool.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Data/Scalar.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Primitive/Operators.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/What.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/Basics.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/Combinators.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/UPSel.hs

index 9a29d5d..8d6f42b 100644 (file)
@@ -128,7 +128,7 @@ splitAsD
 splitAsD gang dlen !arr 
   = zipWithD WhatSlice (seqGang gang) (Seq.slice "splitAsD" arr) is dlen
   where
-    is = fst $ scanD gang (+) 0 dlen
+    is  = fst $ scanD (What "splitAsD") gang (+) 0 dlen
 {-# INLINE_DIST splitAsD #-}
 
 
@@ -180,10 +180,12 @@ joinD_impl g !darr
   = checkGangD (here "joinD") g darr 
   $ Seq.new n (\ma -> zipWithDST_ g (copy ma) di darr)
   where
-    (!di,!n)      = scanD g (+) 0 $ lengthD darr
+    (!di,!n)    = scanD (What "joinD_impl") g (+) 0 
+                $ lengthD darr
 
     copy :: forall s. MVector s a -> Int -> Vector a -> DistST s ()
-    copy ma i arr = stToDistST (Seq.copy (Seq.mslice i (Seq.length arr) ma) arr)
+    copy ma i arr 
+        = stToDistST (Seq.copy (Seq.mslice i (Seq.length arr) ma) arr)
 {-# INLINE_DIST joinD_impl #-}
 
 
@@ -209,9 +211,10 @@ joinDM g darr
         zipWithDST_ g (copy marr) di darr
         return marr
  where
-        (!di,!n) = scanD g (+) 0 $ lengthD darr
+        (!di,!n) = scanD (What "joinDM") g (+) 0 
+                 $ lengthD darr
 
-        copy ma i arr = stToDistST (Seq.copy (Seq.mslice i (Seq.length arr) ma) arr)
+        copy ma i arr   = stToDistST (Seq.copy (Seq.mslice i (Seq.length arr) ma) arr)
 {-# INLINE joinDM #-}
 
 
index e37cc21..3cd94c3 100644 (file)
@@ -9,6 +9,7 @@ where
 import Data.Array.Parallel.Unlifted.Distributed.Data.Scalar.Base        ()
 import Data.Array.Parallel.Unlifted.Distributed.Primitive.DPrim
 import Data.Array.Parallel.Unlifted.Distributed.Primitive
+import Data.Array.Parallel.Unlifted.Distributed.What
 import qualified Data.Array.Parallel.Unlifted.Sequential.Vector as V
 import qualified Data.Vector.Unboxed.Mutable                    as MV
 import Prelude as P
@@ -37,13 +38,13 @@ instance DT Bool where
 
 -- | OR together all instances of a distributed 'Bool'.
 orD :: Gang -> Dist Bool -> Bool
-orD g   = foldD g (||)
+orD g   = foldD (What "orD") g (||)
 {-# INLINE_DIST orD #-}
 
 
 -- | AND together all instances of a distributed 'Bool'.
 andD :: Gang -> Dist Bool -> Bool
-andD g  = foldD g (&&)
+andD g  = foldD (What "andD") g (&&)
 {-# INLINE_DIST andD #-}
 
 
index 6c1a58d..d4dcb53 100644 (file)
@@ -12,6 +12,7 @@ import Data.Array.Parallel.Unlifted.Distributed.Data.Scalar.Base
 import Data.Array.Parallel.Unlifted.Distributed.Data.Unit
 import Data.Array.Parallel.Unlifted.Distributed.Combinators
 import Data.Array.Parallel.Unlifted.Distributed.Primitive
+import Data.Array.Parallel.Unlifted.Distributed.What
 import Data.Array.Parallel.Pretty
 import qualified Data.Array.Parallel.Unlifted.Sequential.Vector as V
 import Prelude as P
@@ -33,5 +34,5 @@ scalarD gang x
 
 -- | Sum all instances of a distributed number.
 sumD :: (Num a, DT a) => Gang -> Dist a -> a
-sumD g  = foldD g (+)
+sumD g  = foldD (What "sumD") g (+)
 {-# INLINE_DIST sumD #-}
index e07b803..70c9be9 100644 (file)
@@ -77,29 +77,33 @@ imapD' what gang f !d
 
 -- Folding --------------------------------------------------------------------
 -- | Fold all the instances of a distributed value.
-foldD :: DT a => Gang -> (a -> a -> a) -> Dist a -> a
-foldD g f !d 
-  = checkGangD ("here foldD") g d 
+foldD :: DT a => What -> Gang -> (a -> a -> a) -> Dist a -> a
+foldD what gang f !d 
+  = traceEvent (show (CompFold what))
+  $ checkGangD ("here foldD") gang d 
   $ fold 1 (indexD (here "foldD") d 0)
   where
-    !n = gangSize g
-    --
-    fold i x | i == n    = x
-             | otherwise = fold (i+1) (f x $ indexD (here "foldD") d i)
+    !n  = gangSize gang
+
+    fold i x 
+        | i == n    = x
+        | otherwise = fold (i+1) (f x $ indexD (here "foldD") d i)
 {-# NOINLINE foldD #-}
 
 
+-- Scanning -------------------------------------------------------------------
 -- | Prefix sum of the instances of a distributed value.
-scanD :: forall a. DT a => Gang -> (a -> a -> a) -> a -> Dist a -> (Dist a, a)
-scanD g f z !d
-  = checkGangD (here "scanD") g d 
+scanD :: forall a. DT a => What -> Gang -> (a -> a -> a) -> a -> Dist a -> (Dist a, a)
+scanD what gang f z !d
+  = traceEvent (show (CompScan what))
+  $ checkGangD (here "scanD") gang d 
   $ runST (do
-          md <- newMD g
-          s  <- scan md 0 z
-          d' <- unsafeFreezeMD md
-          return (d',s))
+        md <- newMD gang
+        s  <- scan md 0 z
+        d' <- unsafeFreezeMD md
+        return (d',s))
   where
-    !n = gangSize g
+    !n  = gangSize gang
     
     scan :: forall s. MDist a s -> Int -> a -> ST s a
     scan md i !x
index be08692..1aece2a 100644 (file)
@@ -8,12 +8,12 @@ where
 
 -- | What computation we are doing.
 data Comp
-        = CompGenerate
-                { compCheap     :: Bool
-                , compWhat      :: What}
+        = CompGenerate  { compCheap     :: Bool
+                        , compWhat      :: What}
 
-        | CompMap
-                { compWhat      :: What }
+        | CompMap       { compWhat      :: What }
+        | CompFold      { compWhat      :: What }
+        | CompScan      { compWhat      :: What }
         deriving Show
 
 -- | What sort of thing is being computed.
index 2a13915..0c1f700 100644 (file)
@@ -74,9 +74,13 @@ indexedUP :: (DT e, Unbox e) => Vector e -> Vector (Int,e)
 indexedUP 
  = splitJoinD theGang indexedFn 
  where
-    sizes  arr   = fst $ scanD theGang (+) 0 $ lengthD arr
-    indexedFn    = \arr -> zipWithD (What "indexedUP.map") theGang 
-                                (\o -> Seq.map (\(x,y) -> (x + o, y)))
-                                (sizes arr) 
-                         $  mapD (What "indexedUP/indexed") theGang Seq.indexed arr
+    sizes  arr   
+        = fst 
+        $ scanD (What "indexedUP/length") theGang (+) 0 $ lengthD arr
+
+    indexedFn    
+        = \arr -> zipWithD (What "indexedUP.map") theGang 
+                    (\o -> Seq.map (\(x,y) -> (x + o, y)))
+                    (sizes arr) 
+               $  mapD     (What "indexedUP/indexed") theGang Seq.indexed arr
 {-# INLINE_UP indexedUP #-}
index 6779757..9edd482 100644 (file)
@@ -111,9 +111,9 @@ zipWithUP f xs ys
 --
 foldUP  :: (Unbox a, DT a) => (a -> a -> a) -> a -> Vector a -> a
 foldUP f !z xs
-        = foldD theGang f
-                (mapD   (What "foldUP/fold") theGang (Seq.fold f z)
-                (splitD theGang unbalanced xs))
+        = foldD (What "foldUP/f")    theGang f
+        $ mapD  (What "foldUP/fold") theGang (Seq.fold f z)
+        $ splitD theGang unbalanced xs
 {-# INLINE_UP foldUP #-}
 
 
@@ -152,7 +152,7 @@ fold1UP = foldl1UP
 foldl1UP :: (DT a, Unbox a) => (a -> a -> a) -> Vector a -> a
 foldl1UP f arr 
         = (maybe z (f z)
-        . foldD  theGang combine'
+        . foldD  (What "fold1UP/foldD")      theGang combine'
         . mapD   (What "fold1UP/fold1Maybe") theGang (Seq.foldl1Maybe f)
         . splitD theGang unbalanced) arr
         where
@@ -173,9 +173,14 @@ foldl1UP f arr
 --
 scanUP :: (DT a, Unbox a) => (a -> a -> a) -> a -> Vector a -> Vector a
 scanUP f z 
-        = splitJoinD theGang go
-        where   go xs = let (ds,zs) = unzipD $ mapD (What "scanUP/scanRes") theGang (Seq.scanRes f z) xs
-                            zs'     = fst (scanD theGang f z zs)
-                        in  zipWithD (What "scanUP/map") theGang (Seq.map . f) zs' ds
+ = splitJoinD theGang go
+ where  go xs 
+         = let (ds,zs)  = unzipD 
+                        $ mapD  (What "scanUP/scanRes") theGang (Seq.scanRes f z) xs
+
+               zs'      = fst 
+                        $ scanD (What "scanUP/scan") theGang f z zs
+
+           in  zipWithD (What "scanUP/map") theGang (Seq.map . f) zs' ds
 {-# INLINE_UP scanUP #-}
 
index bf488f4..01bf0ae 100644 (file)
@@ -93,7 +93,7 @@ mkUPSelRep2 tags = zipD idxs lens
          $ splitD theGang balanced tags
 
     idxs = fst
-         $ scanD theGang add (0,0) lens
+         $ scanD  (What "UPSelRep2.mkUPSelRep2/add")   theGang add (0,0) lens
 
     count bs = let ones = US.sum (US.map tagToInt bs)
                in (US.length bs - ones,ones)