dph-prim-par: Add Justifications to distributed array functions
authorBen Lippmeier <benl@ouroborus.net>
Mon, 23 Jul 2012 02:09:06 +0000 (12:09 +1000)
committerBen Lippmeier <benl@ouroborus.net>
Mon, 30 Jul 2012 03:48:35 +0000 (13:48 +1000)
15 files changed:
dph-lifted-vseg/Data/Array/Parallel/Trace.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Arrays.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Basics.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Combinators.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Scalars.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/USSegd.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/USegd.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/What.hs [new file with mode: 0644]
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/Enum.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/Segmented.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/UPSSegd.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/UPSegd.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/UPSel.hs

index 71ab6b2..6a70cfc 100644 (file)
@@ -9,8 +9,8 @@ import Data.Typeable
 import qualified Debug.Trace
 
 traceOp :: Op -> a -> a
-traceOp op x
-        = Debug.Trace.trace (Prelude.show op) x
+traceOp op x = x
+--        = Debug.Trace.trace (Prelude.show op) x
 
 data Trace
         = Trace Op
index 52f315f..9060e3c 100644 (file)
@@ -65,9 +65,10 @@ unbalanced = error $ here "unbalanced: touched"
 --      = [128,128,128,127]@
 -- 
 splitLenD :: Gang -> Int -> Dist Int
-splitLenD g n = generateD_cheap g len
-  where
-    !p = gangSize g
+splitLenD gang n 
+ = generateD_cheap WhatLength gang len
+ where
+    !p = gangSize gang
     !l = n `quotInt` p
     !m = n `remInt`  p
 
@@ -87,9 +88,10 @@ splitLenD g n = generateD_cheap g len
 --      = [(128,0),(128,128),(128,256),(127,384)]@
 --
 splitLenIdxD :: Gang -> Int -> Dist (Int, Int)
-splitLenIdxD g n = generateD_cheap g len_idx
-  where
-    !p = gangSize g
+splitLenIdxD gang n 
+ = generateD_cheap WhatLengthIdx gang len_idx
+ where
+    !p = gangSize gang
     !l = n `quotInt` p
     !m = n `remInt` p
 
@@ -119,11 +121,14 @@ joinLengthD g = sumD g . lengthD
 --   @splitAsD theGangN4 (splitLenD theGangN4 10) [1 2 3 4 5 6 7 8 9 0]
 --      = [[1 2 3] [4 5 6] [7 8] [9 0]]@
 -- 
-splitAsD :: Unbox a => Gang -> Dist Int -> Vector a -> Dist (Vector a)
-splitAsD g dlen !arr 
-  = zipWithD (seqGang g) (Seq.slice "splitAsD" arr) is dlen
+splitAsD 
+        :: Unbox a 
+        => Gang -> Dist Int -> Vector a -> Dist (Vector a)
+
+splitAsD gang dlen !arr 
+  = zipWithD WhatSlice (seqGang gang) (Seq.slice "splitAsD" arr) is dlen
   where
-    is = fst $ scanD g (+) 0 dlen
+    is = fst $ scanD gang (+) 0 dlen
 {-# INLINE_DIST splitAsD #-}
 
 
@@ -133,26 +138,28 @@ splitAsD g dlen !arr
 --         through RULES. Without it, splitJoinD would be a loop breaker.
 -- 
 splitD :: Unbox a => Gang -> Distribution -> Vector a -> Dist (Vector a)
-splitD g _ arr = splitD_impl g arr
+splitD g _ arr 
+        = splitD_impl g arr
 {-# INLINE_DIST splitD #-}
 
 
 splitD_impl :: Unbox a => Gang -> Vector a -> Dist (Vector a)
 splitD_impl g !arr 
-  = generateD_cheap g (\i -> Seq.slice "splitD_impl" arr (idx i) (len i))
-  where
-    n  = Seq.length arr
-    !p = gangSize g
-    !l = n `quotInt` p
-    !m = n `remInt` p
+  = generateD_cheap WhatSlice g 
+        (\i -> Seq.slice "splitD_impl" arr (idx i) (len i))
 
-    {-# INLINE [0] idx #-}
-    idx i | i < m     = (l+1)*i
-          | otherwise = l*i + m
+  where n       = Seq.length arr
+        !p      = gangSize g
+        !l      = n `quotInt` p
+        !m      = n `remInt` p
 
-    {-# INLINE [0] len #-}
-    len i | i < m     = l+1
-          | otherwise = l
+        {-# INLINE [0] idx #-}
+        idx i   | i < m     = (l+1)*i
+                | otherwise = l*i + m
+
+        {-# INLINE [0] len #-}
+        len i   | i < m     = l+1
+                | otherwise = l
 {-# INLINE_DIST splitD_impl #-}
 
 
@@ -231,17 +238,21 @@ joinDM g darr
 
 "Seq.zip/joinD[1]" forall g xs ys.
   Seq.zip (joinD g balanced xs) ys
-    = joinD g balanced (zipWithD g Seq.zip xs (splitD g balanced ys))
+    = joinD g balanced (zipWithD WhatZip g Seq.zip xs (splitD g balanced ys))
 
 "Seq.zip/joinD[2]" forall g xs ys.
   Seq.zip xs (joinD g balanced ys)
-    = joinD g balanced (zipWithD g Seq.zip (splitD g balanced xs) ys)
-
-"Seq.zip/splitJoinD" forall gang f g xs ys.
-  Seq.zip (splitJoinD gang (imapD gang f) xs) (splitJoinD gang (imapD gang g) ys)
-    = splitJoinD gang (imapD gang (\i zs -> let (as,bs) = Seq.unzip zs
-                                            in Seq.zip (f i as) (g i bs)))
-                      (Seq.zip xs ys)
+    = joinD g balanced (zipWithD WhatZip g Seq.zip (splitD g balanced xs) ys)
+
+"Seq.zip/splitJoinD" 
+  forall what1 what2 gang f g xs ys
+  . Seq.zip (splitJoinD gang (imapD what1 gang f) xs) 
+            (splitJoinD gang (imapD what2 gang g) ys)
+  = splitJoinD gang 
+        (imapD (WhatFusedZipMap what1 what2)
+               gang (\i zs -> let (as,bs) = Seq.unzip zs
+                              in Seq.zip (f i as) (g i bs)))
+                    (Seq.zip xs ys)
 
   #-}
 
@@ -263,8 +274,14 @@ permuteD g darr dis
 
 -- NOTE: The bang is necessary because the array must be fully evaluated
 -- before we pass it to the parallel computation.
-bpermuteD :: Unbox a => Gang -> Vector a -> Dist (Vector Int) -> Dist (Vector a)
-bpermuteD g !as ds = mapD g (Seq.bpermute as) ds
+bpermuteD :: Unbox a 
+        => Gang 
+        -> Vector a 
+        -> Dist (Vector Int) 
+        -> Dist (Vector a)
+
+bpermuteD gang !as ds 
+        = mapD WhatBpermute gang (Seq.bpermute as) ds
 {-# INLINE bpermuteD #-}
 
 
index 6c169f6..7b97aab 100644 (file)
@@ -18,21 +18,22 @@ here s = "Data.Array.Parallel.Unlifted.Distributed.Basics." ++ s
 --   This requires a 'Gang' and hence can't be defined in terms of 'Eq'.
 eqD :: (Eq a, DT a) => Gang -> Dist a -> Dist a -> Bool
 eqD g dx dy 
-        = andD g (zipWithD g (==) dx dy)
+        = andD g (zipWithD (What "eq") g (==) dx dy)
 
 
 -- | Test whether to distributed values are not equal.
 --   This requires a 'Gang' and hence can't be defined in terms of 'Eq'.
 neqD :: (Eq a, DT a) => Gang -> Dist a -> Dist a -> Bool
 neqD g dx dy 
-        = orD g (zipWithD g (/=) dx dy)
+        = orD g (zipWithD (What "neq") g (/=) dx dy)
 
 
 -- | Generate a distributed value from the first @p@ elements of a list.
 -- 
 --   * For debugging only, don't use in production code.
 toD :: DT a => Gang -> [a] -> Dist a
-toD g xs = newD g (\md -> zipWithM_ (writeMD md) [0 .. gangSize g - 1] xs)
+toD g xs
+        = newD g (\md -> zipWithM_ (writeMD md) [0 .. gangSize g - 1] xs)
 
 
 -- | Yield all elements of a distributed value.
index 78b0f46..2916442 100644 (file)
@@ -5,7 +5,8 @@
 
 -- | Standard combinators for distributed types.
 module Data.Array.Parallel.Unlifted.Distributed.Combinators 
-        ( generateD, generateD_cheap
+        ( What (..)
+        , generateD, generateD_cheap
         , imapD, mapD
         , zipD, unzipD
         , fstD, sndD
@@ -21,15 +22,23 @@ import Data.Array.Parallel.Base ( ST, runST)
 import Data.Array.Parallel.Unlifted.Distributed.Gang
 import Data.Array.Parallel.Unlifted.Distributed.Types
 import Data.Array.Parallel.Unlifted.Distributed.DistST
-
+import Data.Array.Parallel.Unlifted.Distributed.What
+import Debug.Trace
 
 here s = "Data.Array.Parallel.Unlifted.Distributed.Combinators." ++ s
 
+
 -- | Create a distributed value, given a function to create the instance
 --   for each thread.
-generateD :: DT a => Gang -> (Int -> a) -> Dist a
-generateD g f 
-        = runDistST g (myIndex >>= return . f)
+generateD 
+        :: DT a 
+        => What         -- ^ What is the worker function doing.
+        -> Gang 
+        -> (Int -> a) 
+        -> Dist a
+generateD what g f 
+        = traceEvent (show $ CompGenerate False what) 
+        $ runDistST g (myIndex >>= return . f)
 {-# NOINLINE generateD #-}
 
 
@@ -40,56 +49,99 @@ generateD g f
 --   a single integer to each thread, then there's no need to fire up the 
 --   gang for this.
 --   
-generateD_cheap :: DT a => Gang -> (Int -> a) -> Dist a
-generateD_cheap g f 
-        = runDistST_seq g (myIndex >>= return . f)
+generateD_cheap 
+        :: DT a 
+        => What          -- ^ What is the worker function doing.
+        -> Gang 
+        -> (Int -> a) 
+        -> Dist a
+
+generateD_cheap what g f 
+        = traceEvent (show $ CompGenerate True what) 
+        $ runDistST_seq g (myIndex >>= return . f)
 {-# NOINLINE generateD_cheap #-}
 
 
 -- Mapping --------------------------------------------------------------------
+--
+-- Fusing maps
+-- ~~~~~~~~~~~
+--  The staging here is important. 
+--  Our rewrite rules only operate on the imapD form, so fusion between the worker
+--  functions of consecutive maps takes place before phase [0]. 
+--
+--  At phase [0] we then inline imapD which introduces the call to imapD' which
+--  uses the gang to evaluate its (now fused) worker.
+--
+
+-- | Map a function to every instance of a distributed value.
+--
+--   This applies the function to every thread, but not every value held
+--   by the thread. If you want that then use something like:
+-- 
+--   @mapD theGang (V.map (+ 1)) :: Dist (Vector Int) -> Dist (Vector Int)@
+--
+mapD    :: (DT a, DT b) 
+        => What         -- ^ What is the worker function doing.
+        -> Gang 
+        -> (a -> b) 
+        -> Dist a 
+        -> Dist b
+
+mapD wFn gang
+        = imapD wFn gang . const
+{-# INLINE mapD #-}
+--  INLINE because this is just a convenience wrapper for imapD.
+--  None of our rewrite rules are particular to mapD.
+
+
 -- | Map a function across all elements of a distributed value.
 --   The worker function also gets the current thread index.
 --   As opposed to `imapD'` this version also deepSeqs each element before
 --   passing it to the function.
-imapD :: (DT a, DT b) => Gang -> (Int -> a -> b) -> Dist a -> Dist b
-imapD g f d = imapD' g (\i x -> x `deepSeqD` f i x) d
+imapD   :: (DT a, DT b) 
+        => What         -- ^ What is the worker function doing.
+        -> Gang 
+        -> (Int -> a -> b) 
+        -> Dist a -> Dist b
+imapD wFn gang f d 
+        = imapD' wFn gang (\i x -> x `deepSeqD` f i x) d
 {-# INLINE [0] imapD #-}
+--  INLINE [0] because we want to wait until phase [0] before introducing
+--  the call to imapD'. Our rewrite rules operate directly on the imapD
+--  formp, so once imapD is inlined no more fusion can take place.
 
 
 -- | Map a function across all elements of a distributed value.
 --   The worker function also gets the current thread index.
-imapD' :: (DT a, DT b) => Gang -> (Int -> a -> b) -> Dist a -> Dist b
-imapD' g f !d 
-  = checkGangD (here "imapD") g d
-  $ runDistST g 
+imapD'  :: (DT a, DT b) 
+        => What -> Gang -> (Int -> a -> b) -> Dist a -> Dist b
+imapD' what gang f !d 
+  = traceEvent (show (CompMap $ what))
+  $ runDistST gang 
         (do i <- myIndex
             x <- myD d
             return (f i x))
 {-# NOINLINE imapD' #-}
-
-
--- | Map a function to every instance of a distributed value.
---
---   This applies the function to every thread, but not every value held
---   by the thread. If you want that then use something like:
--- 
---   @mapD theGang (V.map (+ 1)) :: Dist (Vector Int) -> Dist (Vector Int)@
---
-mapD :: (DT a, DT b) => Gang -> (a -> b) -> Dist a -> Dist b
-mapD g = imapD g . const
-{-# INLINE mapD #-}
+-- NOINLINE 
 
 
 {-# RULES
 
-"imapD/generateD" forall gang f g.
-  imapD gang f (generateD gang g) = generateD gang (\i -> f i (g i))
+"imapD/generateD" 
+  forall wMap wGen gang f g
+  . imapD wMap gang f (generateD wGen gang g) 
+  = generateD (WhatFusedMapGen wMap wGen) gang (\i -> f i (g i))
 
-"imapD/generateD_cheap" forall gang f g.
-  imapD gang f (generateD_cheap gang g) = generateD gang (\i -> f i (g i))
+"imapD/generateD_cheap" 
+  forall wMap wGen gang f g
+  . imapD wMap gang f (generateD_cheap wGen gang g) 
+  = generateD (WhatFusedMapGen wMap wGen) gang (\i -> f i (g i))
 
-"imapD/imapD" forall gang f g d.
-  imapD gang f (imapD gang g d) = imapD gang (\i x -> f i (g i x)) d
+"imapD/imapD" 
+  forall wMap1 wMap2 gang f g d
+  . imapD wMap1 gang f (imapD wMap2 gang g d) 
+  = imapD (WhatFusedMapMap wMap1 wMap2) gang (\i x -> f i (g i x)) d
 
   #-}
 
@@ -97,35 +149,49 @@ mapD g = imapD g . const
 -- Zipping --------------------------------------------------------------------
 -- | Combine two distributed values with the given function.
 zipWithD :: (DT a, DT b, DT c)
-         => Gang -> (a -> b -> c) -> Dist a -> Dist b -> Dist c
-zipWithD g f dx dy = mapD g (uncurry f) (zipD dx dy)
+        => What                 -- ^ What is the worker function doing.
+        -> Gang 
+        -> (a -> b -> c) 
+        -> Dist a -> Dist b -> Dist c
+
+zipWithD what g f dx dy 
+        = mapD what g (uncurry f) (zipD dx dy)
 {-# INLINE zipWithD #-}
 
 
 -- | Combine two distributed values with the given function.
 --   The worker function also gets the index of the current thread.
 izipWithD :: (DT a, DT b, DT c)
-          => Gang -> (Int -> a -> b -> c) -> Dist a -> Dist b -> Dist c
-izipWithD g f dx dy = imapD g (\i -> uncurry (f i)) (zipD dx dy)
+          => What               -- ^ What is the worker function doing.
+          -> Gang 
+          -> (Int -> a -> b -> c) 
+          -> Dist a -> Dist b -> Dist c
+
+izipWithD what g f dx dy 
+        = imapD what g (\i -> uncurry (f i)) (zipD dx dy)
 {-# INLINE izipWithD #-}
 
 
 {-# RULES
-"zipD/imapD[1]" forall gang f xs ys.
-  zipD (imapD gang f xs) ys
-    = imapD gang (\i (x,y) -> (f i x,y)) (zipD xs ys)
-
-"zipD/imapD[2]" forall gang f xs ys.
-  zipD xs (imapD gang f ys)
-    = imapD gang (\i (x,y) -> (x, f i y)) (zipD xs ys)
-
-"zipD/generateD[1]" forall gang f xs.
-  zipD (generateD gang f) xs
-    = imapD gang (\i x -> (f i, x)) xs
-
-"zipD/generateD[2]" forall gang f xs.
-  zipD xs (generateD gang f)
-    = imapD gang (\i x -> (x, f i)) xs
+"zipD/imapD[1]" 
+  forall gang f xs ys what
+  . zipD (imapD what gang f xs) ys
+  = imapD what gang (\i (x,y) -> (f i x, y)) (zipD xs ys)
+
+"zipD/imapD[2]" 
+  forall gang f xs ys what
+  . zipD xs (imapD what gang f ys)
+  = imapD what gang (\i (x,y) -> (x, f i y)) (zipD xs ys)
+
+"zipD/generateD[1]" 
+  forall gang f xs what
+  . zipD (generateD what gang f) xs
+  = imapD what gang (\i x -> (f i, x)) xs
+
+"zipD/generateD[2]" 
+  forall gang f xs what
+  . zipD xs (generateD what gang f)
+  = imapD what gang (\i x -> (x, f i)) xs
 
   #-}
 
@@ -165,6 +231,8 @@ scanD g f z !d
 {-# NOINLINE scanD #-}
 
 
+
+-- MapAccumL ------------------------------------------------------------------
 -- | Combination of map and fold.
 mapAccumLD 
         :: forall a b acc. (DT a, DT b)
index bcb4c55..6da257a 100644 (file)
@@ -17,21 +17,22 @@ import Data.Array.Parallel.Unlifted.Distributed.Combinators
 --   Each thread gets its own copy of the same value.
 --   Example:  scalarD theGangN4 10 = [10, 10, 10, 10] 
 scalarD :: DT a => Gang -> a -> Dist a
-scalarD g x = mapD g (const x) (unitD g)
+scalarD gang x 
+        = mapD WhatScalar gang (const x) (unitD gang)
 
 
 -- | OR together all instances of a distributed 'Bool'.
 orD :: Gang -> Dist Bool -> Bool
-orD g = foldD g (||)
+orD g   = foldD g (||)
 
 
 -- | AND together all instances of a distributed 'Bool'.
 andD :: Gang -> Dist Bool -> Bool
-andD g = foldD g (&&)
+andD g  = foldD g (&&)
 
 
 -- | Sum all instances of a distributed number.
 sumD :: (Num a, DT a) => Gang -> Dist a -> a
-sumD g = foldD g (+)
+sumD g  = foldD g (+)
 
 
index 44b87f9..3107436 100644 (file)
@@ -56,7 +56,8 @@ here s = "Data.Array.Parallel.Unlifted.Distributed.USSegd." ++ s
 splitSSegdOnElemsD :: Gang -> USSegd -> Dist ((USSegd,Int),Int)
 splitSSegdOnElemsD g !segd 
   = {-# SCC "splitSSegdOnElemsD" #-}
-    imapD g mk (splitLenIdxD g (USegd.takeElements $ USSegd.takeUSegd segd))
+    imapD (What "UPSSegd.splitSSegdOnElems/splitLenIx") g mk 
+        (splitLenIdxD g (USegd.takeElements $ USSegd.takeUSegd segd))
   where 
         -- Number of threads in gang.
         !nThreads = gangSize g
index 395cf1f..a0f73c2 100644 (file)
@@ -56,7 +56,7 @@ here s = "Data.Array.Parallel.Unlifted.Distributed.USegd." ++ s
 --
 splitSegdOnSegsD :: Gang -> USegd -> Dist USegd
 splitSegdOnSegsD g !segd 
-  = mapD g USegd.fromLengths
+  = mapD (What "USegd.splitSegdOnSegds/fromLengths") g USegd.fromLengths
   $ splitAsD g d lens
   where
     !d   = snd
@@ -113,7 +113,8 @@ splitSegdOnSegsD g !segd
 splitSegdOnElemsD :: Gang -> USegd -> Dist ((USegd,Int),Int)
 splitSegdOnElemsD g !segd 
   = {-# SCC "splitSegdOnElemsD" #-} 
-    imapD g mk (splitLenIdxD g (USegd.takeElements segd))
+    imapD (What "USegd.splitSegdOnElemsD/splitLenIdx") g mk 
+        (splitLenIdxD g (USegd.takeElements segd))
   where 
         -- Number of threads in gang.
         !nThreads = gangSize g
@@ -299,7 +300,7 @@ joinSegdD :: Gang -> Dist USegd -> USegd
 joinSegdD gang
         = USegd.fromLengths
         . joinD gang unbalanced
-        . mapD  gang USegd.takeLengths
+        . mapD  (What "joinSegdD/takeLengths") gang USegd.takeLengths
 {-# INLINE_DIST joinSegdD #-}
 
 
@@ -319,13 +320,14 @@ glueSegdD gang bundle
         -- | Whether the last segment in this chunk extends into the next chunk.
         segSplits :: Dist Bool
         !segSplits
-         = generateD_cheap gang $ \ix 
+         = generateD_cheap (What "glueSegdD/segd_offsegs") gang $ \ix 
          -> if ix >= sizeD lengths - 1
              then False
              else indexD (here "glueSegdD") firstSegOffsets (ix + 1) /= 0
 
         !lengths'       = fst $ carryD gang (+)                  0 segSplits lengths
-        !dusegd'        = mapD gang USegd.fromLengths lengths'
+        !dusegd'        = mapD (What "glueSegdD/fromLenghts") gang 
+                                USegd.fromLengths lengths'
 
   in    dusegd'
 {-# INLINE_DIST glueSegdD #-}
@@ -339,11 +341,16 @@ splitSD g dsegd xs
 
 {-# RULES
 
-"splitSD/splitJoinD" forall g d f xs.
-  splitSD g d (splitJoinD g f xs) = f (splitSD g d xs)
-
-"splitSD/Seq.zip" forall g d xs ys.
-  splitSD g d (Seq.zip xs ys) = zipWithD g Seq.zip (splitSD g d xs)
-                                             (splitSD g d ys)
+"splitSD/splitJoinD" 
+  forall g d f xs
+  . splitSD g d (splitJoinD g f xs)
+  = f (splitSD g d xs)
+
+"splitSD/Seq.zip" 
+  forall g d xs ys
+  . splitSD g d (Seq.zip xs ys) 
+  = zipWithD WhatZip g Seq.zip 
+        (splitSD g d xs)
+        (splitSD g d ys)
 
   #-}
diff --git a/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/What.hs b/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/What.hs
new file mode 100644 (file)
index 0000000..be08692
--- /dev/null
@@ -0,0 +1,32 @@
+
+module Data.Array.Parallel.Unlifted.Distributed.What
+        ( Comp  (..)
+        , What  (..))
+where
+        
+
+
+-- | What computation we are doing.
+data Comp
+        = CompGenerate
+                { compCheap     :: Bool
+                , compWhat      :: What}
+
+        | CompMap
+                { compWhat      :: What }
+        deriving Show
+
+-- | What sort of thing is being computed.
+data What
+        = What            String
+        | WhatScalar 
+        | WhatZip
+        | WhatSlice
+        | WhatLength
+        | WhatLengthIdx
+        | WhatBpermute
+
+        | WhatFusedMapMap What What
+        | WhatFusedMapGen What What
+        | WhatFusedZipMap What What
+        deriving Show
index ac77457..2a13915 100644 (file)
@@ -13,6 +13,7 @@ module Data.Array.Parallel.Unlifted.Parallel.Basics
 where
 import Data.Array.Parallel.Unlifted.Sequential.Vector as Seq
 import Data.Array.Parallel.Unlifted.Distributed
+import Data.Array.Parallel.Unlifted.Distributed.What
 import Data.Array.Parallel.Unlifted.Parallel.Combinators (mapUP)
 import Data.Array.Parallel.Unlifted.Parallel.Enum        (enumFromToUP)
 import Data.Array.Parallel.Unlifted.Parallel.Permute     (bpermuteUP)
@@ -29,7 +30,7 @@ emptyUP = Seq.new 0 (const $ return ())
 replicateUP :: Unbox e => Int -> e -> Vector e
 replicateUP n !e 
         = joinD theGang balanced
-        . mapD theGang (\n' ->Seq.replicate n' e)
+        . mapD  (What "replicateUP/replicate") theGang (\n' ->Seq.replicate n' e)
         $ splitLenD theGang n
 {-# INLINE_UP replicateUP #-}
 
@@ -62,7 +63,7 @@ nullUP  = (== 0) . Seq.length
 interleaveUP :: Unbox e => Vector e -> Vector e -> Vector e
 interleaveUP xs ys
         = joinD theGang unbalanced
-        $ zipWithD theGang Seq.interleave
+        $ zipWithD (What "interleaveUP/interleave") theGang Seq.interleave
                 (splitD theGang balanced xs)
                 (splitD theGang balanced ys)
 {-# INLINE_UP interleaveUP #-}
@@ -74,8 +75,8 @@ indexedUP
  = splitJoinD theGang indexedFn 
  where
     sizes  arr   = fst $ scanD theGang (+) 0 $ lengthD arr
-    indexedFn    = \arr -> zipWithD theGang 
+    indexedFn    = \arr -> zipWithD (What "indexedUP.map") theGang 
                                 (\o -> Seq.map (\(x,y) -> (x + o, y)))
                                 (sizes arr) 
-                         $  mapD theGang Seq.indexed arr
+                         $  mapD (What "indexedUP/indexed") theGang Seq.indexed arr
 {-# INLINE_UP indexedUP #-}
index d447d14..6779757 100644 (file)
@@ -13,6 +13,7 @@ module Data.Array.Parallel.Unlifted.Parallel.Combinators
 where
 import Data.Array.Parallel.Base
 import Data.Array.Parallel.Unlifted.Distributed
+import Data.Array.Parallel.Unlifted.Distributed.What
 import Data.Array.Parallel.Unlifted.Parallel.UPSel
 import Data.Array.Parallel.Unlifted.Sequential.Vector as Seq
 
@@ -23,7 +24,8 @@ here s = "Data.Array.Parallel.Unlifted.Parallel.Combinators." Prelude.++ s
 -- | Apply a worker to all elements of an array.
 mapUP :: (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
 mapUP f xs 
-        = splitJoinD theGang (mapD theGang (Seq.map f)) xs
+        = splitJoinD theGang 
+                (mapD (What "mapUP/map") theGang (Seq.map f)) xs
 {-# INLINE_UP mapUP #-}
 
 
@@ -31,7 +33,7 @@ mapUP f xs
 filterUP :: Unbox a => (a -> Bool) -> Vector a -> Vector a
 filterUP f
         = joinD  theGang unbalanced
-        . mapD   theGang (Seq.filter f)
+        . mapD   (What "filterUP/filter") theGang (Seq.filter f)
         . splitD theGang unbalanced
 {-# INLINE_UP filterUP #-}
 
@@ -75,7 +77,7 @@ combine2UP tags rep !xs !ys
                 ("tags length /= sum of args length")
                 (Seq.length tags) (Seq.length xs + Seq.length ys)
         $ joinD    theGang balanced
-        $ zipWithD theGang go rep
+        $ zipWithD (What "combine2UP/go") theGang go rep
         $ splitD   theGang balanced tags
         where   go ((i,j), (m,n)) ts 
                  = Seq.combine2ByTag ts 
@@ -89,7 +91,7 @@ zipWithUP :: (Unbox a, Unbox b, Unbox c)
           => (a -> b -> c) -> Vector a -> Vector b -> Vector c
 zipWithUP f xs ys
         = splitJoinD theGang 
-                (mapD theGang (Seq.map (uncurry f))) 
+                (mapD (What "zipWithUP/map") theGang (Seq.map (uncurry f))) 
                 (Seq.zip xs ys)
 {-# INLINE_UP zipWithUP #-}
 
@@ -110,7 +112,7 @@ zipWithUP f xs ys
 foldUP  :: (Unbox a, DT a) => (a -> a -> a) -> a -> Vector a -> a
 foldUP f !z xs
         = foldD theGang f
-                (mapD   theGang (Seq.fold f z)
+                (mapD   (What "foldUP/fold") theGang (Seq.fold f z)
                 (splitD theGang unbalanced xs))
 {-# INLINE_UP foldUP #-}
 
@@ -151,7 +153,7 @@ foldl1UP :: (DT a, Unbox a) => (a -> a -> a) -> Vector a -> a
 foldl1UP f arr 
         = (maybe z (f z)
         . foldD  theGang combine'
-        . mapD   theGang (Seq.foldl1Maybe f)
+        . mapD   (What "fold1UP/fold1Maybe") theGang (Seq.foldl1Maybe f)
         . splitD theGang unbalanced) arr
         where
                 z = Seq.index (here "fold1UP") arr 0
@@ -172,8 +174,8 @@ 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 theGang (Seq.scanRes f z) xs
+        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 theGang (Seq.map . f) zs' ds
+                        in  zipWithD (What "scanUP/map") theGang (Seq.map . f) zs' ds
 {-# INLINE_UP scanUP #-}
 
index 37c06da..98fe263 100644 (file)
@@ -10,6 +10,7 @@ module Data.Array.Parallel.Unlifted.Parallel.Enum
 where
 import Data.Array.Parallel.Unlifted.Sequential.Vector as Seq
 import Data.Array.Parallel.Unlifted.Distributed
+import Data.Array.Parallel.Unlifted.Distributed.What
 import Data.Array.Parallel.Unlifted.Parallel.Combinators (mapUP)
 import GHC.Base                                          (divInt)
 
@@ -45,7 +46,7 @@ enumFromThenToUP start next end
 enumFromStepLenUP :: Int -> Int -> Int -> Vector Int
 enumFromStepLenUP start delta len =
   joinD theGang balanced
-  (mapD theGang gen
+  (mapD (What "enumFromStepLenUP/gen") theGang gen
   (splitLenIdxD theGang len))
   where
     gen (n,i) = Seq.enumFromStepLen (i * delta + start) delta n
@@ -56,7 +57,7 @@ enumFromStepLenEachUP
         :: Int -> Vector Int -> Vector Int -> Vector Int -> Vector Int
 enumFromStepLenEachUP _n starts steps lens
   = joinD theGang unbalanced
-  $ mapD theGang enum
+  $ mapD  (What "enumFromStepLenEachUP/enum") theGang enum
   $ splitD theGang unbalanced (Seq.zip (Seq.zip starts steps) lens)
   where
     enum ps = let (qs, llens) = Seq.unzip ps
index dffdb3f..031bdf5 100644 (file)
@@ -11,6 +11,7 @@ module Data.Array.Parallel.Unlifted.Parallel.Segmented
         , sumRUP)
 where
 import Data.Array.Parallel.Unlifted.Distributed
+import Data.Array.Parallel.Unlifted.Distributed.What
 import Data.Array.Parallel.Unlifted.Parallel.Basics
 import Data.Array.Parallel.Unlifted.Parallel.UPSegd                     (UPSegd)
 import Data.Array.Parallel.Unlifted.Sequential.USegd                    (USegd)
@@ -59,7 +60,7 @@ appendSUP
 
 appendSUP segd !xd !xs !yd !ys
   = joinD theGang balanced
-  . mapD  theGang append
+  . mapD  (What "appendSUP/append") theGang append
   $ UPSegd.takeDistributed segd
   where append ((segd',seg_off),el_off)
          = Seq.unstream
@@ -192,7 +193,7 @@ appendSUPV
 
 appendSUPV segd !xd !xs !yd !ys
   = joinD theGang balanced
-  . mapD  theGang append
+  . mapD  (What "appendSUPV/append") theGang append
   $ UPSegd.takeDistributed segd
   where append ((segd',seg_off),el_off)
          = Seq.unstream
@@ -378,7 +379,7 @@ appendSUP_old
 
 appendSUP_old segd !xd !xs !yd !ys
   = joinD theGang balanced
-  . mapD  theGang append
+  . mapD  (What "appendSUP_old/append") theGang append
   $ UPSegd.takeDistributed segd
   where append ((segd',seg_off),el_off)
          = Seq.unstream
@@ -453,9 +454,9 @@ appendSegS_old !xd !xs !yd !ys !n seg_off el_off
 foldRUP :: (Unbox a, Unbox b) => (b -> a -> b) -> b -> Int -> Vector a -> Vector b
 foldRUP f z !segSize xs 
   = joinD theGang unbalanced
-          (mapD theGang 
+          (mapD (What "foldRUP/foldRU") theGang 
               (Seq.foldlRU f z segSize)
-              (splitAsD theGang (mapD theGang (*segSize) dlen) xs))
+              (splitAsD theGang (mapD (What "foldRUP/segSize") theGang (*segSize) dlen) xs))
   where
     noOfSegs    = Seq.length xs `div` segSize
     dlen        = splitLenD theGang noOfSegs
index 68c4c5d..68434ce 100644 (file)
@@ -38,6 +38,7 @@ module Data.Array.Parallel.Unlifted.Parallel.UPSSegd
 where
 import Data.Array.Parallel.Pretty                                 hiding (empty)
 import Data.Array.Parallel.Unlifted.Distributed
+import Data.Array.Parallel.Unlifted.Distributed.What
 import Data.Array.Parallel.Unlifted.Parallel.UPSegd               (UPSegd)
 import Data.Array.Parallel.Unlifted.Sequential.USSegd             (USSegd)
 import Data.Array.Parallel.Unlifted.Sequential.Vector             (Vector,  MVector, Unbox)
@@ -283,7 +284,8 @@ foldSegsWithP fElem fSeg segd xss
 
  where  (dcarry,drs)
           = unzipD
-          $ mapD theGang partial (takeDistributed segd)
+          $ mapD (What "UPSSegd.foldSegsWithP/partial") theGang 
+                partial (takeDistributed segd)
 
         partial ((ssegd, k), off)
          = let rs = fSeg ssegd xss
index 46a5d0b..7e771f8 100644 (file)
@@ -35,6 +35,7 @@ module Data.Array.Parallel.Unlifted.Parallel.UPSegd
         , foldSegsWithP)
 where
 import Data.Array.Parallel.Unlifted.Distributed
+import Data.Array.Parallel.Unlifted.Distributed.What
 import Data.Array.Parallel.Unlifted.Sequential.USegd             (USegd)
 import qualified Data.Array.Parallel.Unlifted.Distributed.USegd  as USegd
 import qualified Data.Array.Parallel.Unlifted.Sequential         as Seq
@@ -183,7 +184,7 @@ takeElements    = USegd.takeElements . upsegd_usegd
 indicesP :: UPSegd -> Vector Int
 indicesP
         = joinD theGang balanced
-        . mapD  theGang indices
+        . mapD  (What "UPSegd.indicesP/indices") theGang indices
         . takeDistributed
   where
     indices ((segd,_k),off) = Seq.indicesSU' off segd
@@ -200,7 +201,7 @@ indicesP
 replicateWithP :: Unbox a => UPSegd -> Vector a -> Vector a
 replicateWithP segd !xs 
   = joinD theGang balanced
-  . mapD  theGang rep
+  . mapD  (What "UPSegd.replicateWithP/replicateSU") theGang rep
   $ takeDistributed segd
   where
     rep ((dsegd,di),_)
@@ -254,7 +255,7 @@ foldSegsWithP fElem fSeg segd xs
 
  where  (dcarry,drs)
           = unzipD
-          $ mapD theGang partial
+          $ mapD (What "UPSegd.foldSegsWithP/partial") theGang partial
           $ zipD (takeDistributed segd)
                  (splitD theGang balanced xs)
 
index 6fbfc4e..bf488f4 100644 (file)
@@ -23,6 +23,7 @@ where
 import Data.Array.Parallel.Unlifted.Sequential.Vector   as US
 import Data.Array.Parallel.Unlifted.Sequential.USel
 import Data.Array.Parallel.Unlifted.Distributed
+import Data.Array.Parallel.Unlifted.Distributed.What
 import Data.Array.Parallel.Base (Tag, tagToInt)
 
 
@@ -88,7 +89,7 @@ repUPSel2       = upsel2_rep
 mkUPSelRep2 :: Vector Tag -> UPSelRep2
 mkUPSelRep2 tags = zipD idxs lens
   where
-    lens = mapD   theGang count
+    lens = mapD   (What "UPSelRep2.mkUPSelRep2/count") theGang count
          $ splitD theGang balanced tags
 
     idxs = fst
@@ -104,7 +105,7 @@ mkUPSelRep2 tags = zipD idxs lens
 indicesUPSelRep2 :: Vector Tag -> UPSelRep2 -> Vector Int
 indicesUPSelRep2 tags rep 
         = joinD theGang balanced
-        $ zipWithD theGang indices
+        $ zipWithD (What "UPSel.indicesUPSelRep2/split") theGang indices
              (splitD theGang balanced tags)
               rep
   where