dph-prim-par: prettier printing and comments to distributed segment descriptors
authorBen Lippmeier <benl@ouroborus.net>
Thu, 1 Sep 2011 07:06:19 +0000 (17:06 +1000)
committerBen Lippmeier <benl@ouroborus.net>
Thu, 1 Sep 2011 07:06:19 +0000 (17:06 +1000)
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Prim.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Tuple.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/USegd.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Vector.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/USegd.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/UPSegd.hs
dph-prim-par/dph-prim-par.cabal
dph-prim-par/examples/Test.hs [new file with mode: 0644]
dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Segmented/USegd.hs

index e72fb55..69af55b 100644 (file)
@@ -25,7 +25,7 @@ module Data.Array.Parallel.Unlifted.Distributed (
   -- * Distributed arrays
   lengthD, splitLenD, splitLenIdxD,
   splitD, splitAsD, joinLengthD, joinD, splitJoinD, joinDM,
-  splitSegdD, splitSegdD', splitSD,
+  splitSegdOnSegsD, splitSegdOnElemsD, splitSD,
   lengthUSegdD, lengthsUSegdD, indicesUSegdD, elementsUSegdD,
   Distribution, balanced, unbalanced,
 
index ae01f93..8752361 100644 (file)
@@ -2,12 +2,14 @@
 
 -- | Distribution of values of primitive types.
 module Data.Array.Parallel.Unlifted.Distributed.Types.Prim (
-        DPrim(..)
-) where
+        DPrim(..), DT(..), Dist(..)
+)
+where
 import Data.Array.Parallel.Unlifted.Distributed.Types.Base
 import Data.Array.Parallel.Unlifted.Distributed.Gang
 import Data.Array.Parallel.Unlifted.Sequential.Vector
 import Data.Array.Parallel.Base
+import Data.Array.Parallel.Pretty
 import Data.Word
 import Control.Monad
 import qualified Data.Array.Parallel.Unlifted.Sequential.Vector as V
@@ -147,6 +149,10 @@ instance DT Int where
 
   measureD n = "Int " P.++ show n
 
+instance PprPhysical (Dist Int) where
+ pprp (DInt xs)
+  =  text "DInt" <+> text (show $ V.toList xs)
+
 
 -- Word8 ----------------------------------------------------------------------
 instance DPrim Word8 where
index 75e8ead..c65ce29 100644 (file)
@@ -12,6 +12,7 @@ module Data.Array.Parallel.Unlifted.Distributed.Types.Tuple (
 ) where
 import Data.Array.Parallel.Unlifted.Distributed.Types.Base
 import Data.Array.Parallel.Base
+import Data.Array.Parallel.Pretty
 import Control.Monad
 
 here s = "Data.Array.Parallel.Unlifted.Distributed.Types.Tuple." ++ s
@@ -50,6 +51,15 @@ instance (DT a, DT b) => DT (a,b) where
    = "Pair " ++ "(" ++ measureD x ++ ") (" ++  measureD y ++ ")"
 
 
+instance (PprPhysical (Dist a), PprPhysical (Dist b)) 
+        => PprPhysical (Dist (a, b)) where
+ pprp (DProd xs ys)
+  = text "DProd"
+  $$ (nest 8 $ vcat
+        [ pprp xs
+        , pprp ys ])
+
+
 -- | Pairing of distributed values.
 --   The two values must belong to the same 'Gang'.
 zipD :: (DT a, DT b) => Dist a -> Dist b -> Dist (a,b)
index 0d25b9b..2935cc3 100644 (file)
@@ -13,6 +13,7 @@ import Data.Array.Parallel.Unlifted.Distributed.Types.Vector
 import Data.Array.Parallel.Unlifted.Distributed.Types.Base
 import Data.Array.Parallel.Unlifted.Sequential.Segmented.USegd
 import Data.Array.Parallel.Unlifted.Sequential.Vector
+import Data.Array.Parallel.Pretty
 import Control.Monad
 import Prelude                          as P
 
@@ -59,6 +60,15 @@ instance DT USegd where
    = "Segd " P.++ show (lengthUSegd segd) P.++ " " P.++ show (elementsUSegd segd)
 
 
+instance PprPhysical (Dist USegd) where
+ pprp (DUSegd lens indices elements)
+  =  text "DUSegd"
+  $$ (nest 7 $ vcat
+        [ text "lengths: " <+> pprp lens
+        , text "indices: " <+> pprp indices
+        , text "elements:" <+> pprp elements])
+
+
 -- | O(1). Yield the overall number of segments.
 lengthUSegdD :: Dist USegd -> Dist Int
 {-# INLINE_DIST lengthUSegdD #-}
index e86e88f..be70f5a 100644 (file)
@@ -4,9 +4,9 @@
 module Data.Array.Parallel.Unlifted.Distributed.Types.Vector
         (lengthD)
 where
-import Data.Array.Parallel.Unlifted.Distributed.Types.Prim      ()
-import Data.Array.Parallel.Unlifted.Distributed.Types.Base
+import Data.Array.Parallel.Unlifted.Distributed.Types.Prim
 import Data.Array.Parallel.Unlifted.Distributed.Gang
+import Data.Array.Parallel.Pretty
 import Data.Array.Parallel.Unlifted.Sequential.Vector   as V
 import qualified Data.Vector                            as BV
 import qualified Data.Vector.Mutable                    as MBV
@@ -42,6 +42,14 @@ instance Unbox a => DT (V.Vector a) where
   measureD xs           = "Vector " P.++ show (V.length xs)
 
 
+instance (Unbox a, Show a) => PprPhysical (Dist (V.Vector a)) where
+ pprp (DVector (DInt lengths) chunks)
+  = text "DVector"
+  $$ (nest 8 $ vcat
+        [ text "lengths:" <+> (text $ show $ V.toList lengths)
+        , text "chunks: " <+> (text $ show $ BV.toList $ BV.map V.toList chunks) ])
+
+
 -- | Yield the distributed length of a distributed array.
 lengthD :: Unbox a => Dist (Vector a) -> Dist Int
 lengthD (DVector l _) = l
index a493794..3f6df01 100644 (file)
@@ -4,7 +4,9 @@
 
 -- | Operations on Distributed Segment Descriptors
 module Data.Array.Parallel.Unlifted.Distributed.USegd (
-        splitSegdD, splitSegdD', splitSD,
+        splitSegdOnSegsD,
+        splitSegdOnElemsD,
+        splitSD,
         joinSegdD
 )
 where
@@ -20,21 +22,51 @@ import Data.Bits     ( shiftR )
 import Control.Monad ( when )
 
 
-splitSegdD :: Gang -> USegd -> Dist USegd
-{-# NOINLINE splitSegdD #-}
-splitSegdD g !segd = mapD g lengthsToUSegd
-                   $ splitAsD g d lens
+-------------------------------------------------------------------------------
+-- | Split a segment descriptor across the gang, segment wise.
+--   Whole segments are placed on each thread, and we try to balance out
+--   the segments so each thread has the same number of array elements.
+--
+--   We don't split segments across threads, as this would limit our ability
+--   to perform intra-thread fusion of lifted operations. The down side
+--   of this is that if we have few segments with an un-even size distribution
+--   then large segments can cause the gang to become unbalanced.
+--
+--   In the following example the segment with size 100 dominates and
+--   unbalances the gang. There is no reason to put any segments on the
+--   the last thread because we need to wait for the first to finish anyway.
+--
+--   @ > pprp $ splitSegdOnSegsD theGang
+--            $ lengthsToUSegd $ fromList [100, 10, 20, 40, 50  :: Int]
+-- 
+--     DUSegd lengths:   DVector lengths:  [ 1,    3,         1,  0]
+--                                chunks:  [[100],[10,20,40],[50],[]]
+-- 
+--            indices:   DVector lengths:  [1,3,1,0]
+--                                chunks:  [[0],  [0,10,30], [0], []]
+--
+--            elements:  DInt [100,70,50,0]
+--   @
+--
+--  NOTE: This splitSegdOnSegsD function isn't currently used.
+--
+splitSegdOnSegsD :: Gang -> USegd -> Dist USegd
+{-# NOINLINE splitSegdOnSegsD #-}
+splitSegdOnSegsD g !segd 
+  = mapD g lengthsToUSegd
+  $ splitAsD g d lens
   where
-    !d = snd
-       . mapAccumLD g chunks 0
-       . splitLenD g
-       $ elementsUSegd segd
+    !d   = snd
+         . mapAccumLD g chunks 0
+         . splitLenD g
+         $ elementsUSegd segd
 
     n    = lengthUSegd segd
     lens = lengthsUSegd segd
 
-    chunks !i !k = let !j = go i k
-                  in (j,j-i)
+    chunks !i !k 
+      = let !j = go i k
+        in  (j,j-i)
 
     go !i !k | i >= n    = i
              | m == 0    = go (i+1) k
@@ -44,65 +76,138 @@ splitSegdD g !segd = mapD g lengthsToUSegd
         m = lens ! i
 
 
-search :: Int -> Vector Int -> Int
-search !x ys = go 0 (Seq.length ys)
-  where
-    go i n | n <= 0        = i
-           | (ys!mid) < x = go (mid+1) (n-half-1)
-           | otherwise     = go i half
-      where
-        half = n `shiftR` 1
-        mid  = i + half
-
-
-chunk :: USegd -> Int -> Int -> Bool -> (# Vector Int, Int, Int #)
-chunk !segd !di !dn is_last
+-------------------------------------------------------------------------------
+-- | Split a segment descriptor across the gang, element wise.
+--   We try to put the same number of elements on each thread, which means
+--   that segments are sometimes split across threads.
+--
+--   Each thread gets a slice of segment descriptor, the segid of the first 
+--   slice, and the offset of the first slice in its segment.
+--   
+--   Example:
+--    In this picture each X represents 5 elements, and we have 5 segements in total.
+--
+-- @
+--    segs:    ----------------------- --- ------- --------------- -------------------
+--    elems:  |X X X X X X X X X|X X X X X X X X X|X X X X X X X X X|X X X X X X X X X|
+--            |     thread1     |     thread2     |     thread3     |     thread4     |
+--    segid:  0                 0                 3                 4
+--    offset: 0                 45                0                 5
+--
+--   > pprp $ splitSegdOnElemsD theGang 
+--          $ lengthsToUSegd $ fromList [60, 10, 20, 40, 50 :: Int]
+--
+--     segd:    DUSegd lengths:  DVector lengths: [1,3,2,1]
+--                                        chunks:  [[45],[15,10,20],[40,5],[45]]
+--                     indices:  DVector lengths: [1,3,2,1]
+--                                        chunks:  [[0], [0,15,25], [0,40],[0]]
+--                    elements:  DInt [45,45,45,45]
+--
+--     segids: DInt [0,0,3,4]     (segment id of first slice on thread)
+--    offsets: DInt [0,45,0,5]    (offset of that slice in its segment)
+-- @
+--
+splitSegdOnElemsD :: Gang -> USegd -> Dist ((USegd,Int),Int)
+{-# INLINE splitSegdOnElemsD #-}
+splitSegdOnElemsD g !segd 
+  = imapD g mk (splitLenIdxD g (elementsUSegd segd))
+  where 
+        -- Number of threads in gang.
+        !nThreads = gangSize g
+
+        -- Determine what elements go on a thread
+        mk :: Int                  -- Thread index.
+           -> (Int, Int)           -- Number of elements on this thread,
+                                   --   and starting offset into the flat array.
+           -> ((USegd, Int), Int)  -- Segd for this thread, segid of first slice,
+                                   --   and offset of first slice.
+
+        mk i (nElems, ixStart) 
+         = case chunk segd ixStart nElems (i == nThreads - 1) of
+            (# lens, l, o #) -> ((lengthsToUSegd lens, l), o)
+
+
+-- | Determine what elements go on a thread.
+--   The 'chunk' refers to the a chunk of the flat array, and is defined
+--   by a set of segment slices. 
+--
+chunk   :: USegd          -- ^ Segment descriptor of entire array.
+        -> Int            -- ^ Starting offset into the flat array for the first
+                          --   slice on this thread.
+        -> Int            -- ^ Number of elements in this thread.
+        -> Bool           -- ^ Whether this is the last thread in the gang.
+        -> (# Vector Int  -- ^  Lengths of segment slices, 
+            , Int         --     segid of first slice,
+            , Int #)      --     offset of first slice.
+
+chunk !segd !nStart !nElems is_last
   = (# lens', k-left_len, left_off #)
   where
-    !lens' = runST (do
-                      mlens' <- Seq.newM n'
-                      when (left /= 0) $ Seq.write mlens' 0 left
-                      Seq.copy (Seq.mdrop left_len mlens')
-                               (Seq.slice lens k (k'-k))
-                      when (right /= 0) $ Seq.write mlens' (n' - 1) right
-                      Seq.unsafeFreeze mlens')
-
+    -- Lengths of all segments.
+    -- eg: [60, 10, 20, 40, 50]
     lens = lengthsUSegd segd
+
+    -- Starting indices of all segments.
+    -- eg: [0, 60, 70, 90, 130]
     idxs = indicesUSegd segd
+    
+    -- Total number of segments defined by segment descriptor.
+    -- eg: 5
     n    = Seq.length lens
 
-    k  = search di idxs
-    k' | is_last   = n
-       | otherwise = search (di+dn) idxs
+    -- The segid of the first segment on the thread.
+    -- eg: for nStart = 75, 
+    --              k = 2   (the third seg)
+    --
+    k    = search nStart idxs
+
+    -- The segid of the first segment on the next thread.
+    k'       | is_last     = n
+             | otherwise   = search (nStart + nElems) idxs
 
-    left  | k == n    = dn
-          | otherwise = min ((idxs!k) - di) dn
+    left     | k == n      = nElems
+             | otherwise   = min ((idxs ! k) - nStart) nElems
 
-    right | k' == k   = 0
-          | otherwise = di + dn - (idxs ! (k'-1))
+    right    | k' == k     = 0
+             | otherwise   = nStart + nElems - (idxs ! (k'-1))
 
     left_len | left == 0   = 0
              | otherwise   = 1
 
     left_off | left == 0   = 0
-             | otherwise   = di - idxs ! (k-1)
+             | otherwise   = nStart - idxs ! (k-1)
 
     n' = left_len + (k'-k)
 
+    !lens' 
+     = runST (do
+            mlens' <- Seq.newM n'
 
-splitSegdD' :: Gang -> USegd -> Dist ((USegd,Int),Int)
-{-# INLINE splitSegdD' #-}
-splitSegdD' g !segd = imapD g mk
-                         (splitLenIdxD g
-                         (elementsUSegd segd))
-  where
-    !p = gangSize g
+            when (left /= 0) 
+             $ Seq.write mlens' 0 left
+
+            Seq.copy (Seq.mdrop left_len mlens')
+                     (Seq.slice lens k (k'-k))
+
+            when (right /= 0)
+             $ Seq.write mlens' (n' - 1) right
+
+            Seq.unsafeFreeze mlens')
 
-    mk i (dn,di) = case chunk segd di dn (i == p-1) of
-                     (# lens, l, o #) -> ((lengthsToUSegd lens,l),o)
+
+search :: Int -> Vector Int -> Int
+search !x ys = go 0 (Seq.length ys)
+  where
+    go i n | n <= 0        = i
+           | ys ! mid < x  = go (mid + 1) (n - half - 1)
+           | otherwise     = go i half
+      where
+        half = n `shiftR` 1
+        mid  = i + half
 
 
 
+-------------------------------------------------------------------------------
 joinSegdD :: Gang -> Dist USegd -> USegd
 {-# INLINE_DIST joinSegdD #-}
 joinSegdD g = lengthsToUSegd
index eef1caa..8a9fc41 100644 (file)
@@ -64,5 +64,5 @@ mkUPSegd lens idxs n = toUPSegd (mkUSegd lens idxs n)
 
 toUPSegd :: USegd -> UPSegd
 {-# INLINE toUPSegd #-}
-toUPSegd segd = UPSegd segd (splitSegdD' theGang segd)
+toUPSegd segd = UPSegd segd (splitSegdOnElemsD theGang segd)
 
index 86ab34e..78d6a8c 100644 (file)
@@ -47,7 +47,9 @@ Library
   Exposed: False
 
   Extensions: TypeFamilies, GADTs, RankNTypes,
-              BangPatterns, MagicHash, UnboxedTuples, TypeOperators
+              BangPatterns, MagicHash, UnboxedTuples, TypeOperators,
+              FlexibleInstances, FlexibleContexts
+
   GHC-Options: -Odph -funbox-strict-fields -fcpr-off -Werror
 
   Build-Depends:  
diff --git a/dph-prim-par/examples/Test.hs b/dph-prim-par/examples/Test.hs
new file mode 100644 (file)
index 0000000..5d18721
--- /dev/null
@@ -0,0 +1,6 @@
+
+import Data.Array.Parallel.Unlifted.Distributed
+import Data.Array.Parallel.Unlifted.Sequential.Segmented
+import Data.Array.Parallel.Pretty
+import Data.Vector.Unboxed
index 1f57b1b..31c8967 100644 (file)
@@ -14,6 +14,7 @@ module Data.Array.Parallel.Unlifted.Sequential.Segmented.USegd (
   sliceUSegd, extractUSegd
 ) where
 import Data.Array.Parallel.Unlifted.Sequential.Vector as V
+import Data.Array.Parallel.Pretty
 
 -- | Segment descriptors represent the structure of nested arrays.
 --  For each segment, it stores the length and the starting index in the flat data array.
@@ -35,6 +36,16 @@ data USegd
         }
 
 
+-- | Pretty print the physical representation of a `UVSegd`
+instance PprPhysical USegd where
+ pprp (USegd lengths indices elements)
+  =   text "USegd" 
+  $$  (nest 7 $ vcat
+        [ text "lengths: " <+> (text $ show $ V.toList lengths)
+        , text "indices: " <+> (text $ show $ V.toList indices)
+        , text "elements:" <+> (text $ show elements)])
+
+
 -- Constructors ---------------------------------------------------------------
 -- | O(1). Construct a new segment descriptor.
 mkUSegd