Comments and formatting only.
authorBen Lippmeier <benl@ouroborus.net>
Fri, 15 Apr 2011 05:17:24 +0000 (15:17 +1000)
committerBen Lippmeier <benl@ouroborus.net>
Fri, 15 Apr 2011 05:17:24 +0000 (15:17 +1000)
dph-prim-interface/Data/Array/Parallel/Unlifted.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/Combinators.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/Segmented.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/UPSel.hs
dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/USel.hs

index 5401e3a..97cde7b 100644 (file)
@@ -1,5 +1,21 @@
 {-# LANGUAGE TypeOperators, CPP #-}
 
+-- | This module provides the API for the DPH backend. 
+--
+--   These are the DPH array primitives that the vectoriser introduces when
+--   transforming code. The actual code in this module is fake, in the sense
+--   that is provides a partial reference implmentation using lists to
+--   represent arrays, but this code isn't acually used at runtime.
+--
+--   The actual code used by compiled programs depends on whether -fdph-par or
+--   -fdph-seq is passed  when compiling it. Depending on the flag, the
+--   implementation in either the dph-prim-par or dph-prim-seq packages is
+--   swapped in. These packages export the same API, but use a more efficient, 
+--   and perhaps parallel implementation.
+--
+--   All three packages are forced to use the same API by the 'DPH_Header.h'
+--   and 'DPH_Interface.h' include files in dph-prim-interface/interface.
+--
 #include "DPH_Header.h"
 
 import qualified Prelude as P
@@ -7,6 +23,13 @@ import Prelude ( Eq(..), Num(..), Bool(..), ($), (.) )
 
 #include "DPH_Interface.h"
 
+-- NOTE -----------------------------------------------------------------------
+-- See DPH_Interface.h for documentation. 
+--   As these functions are defined multiple times in different packages, 
+--   we keep all the docs there.
+--
+-- The definitions should appear in the same order as they are defined in DPH_Interface.h
+
 #define ASSERT assert __FILE__ __LINE__
 
 assert :: P.String -> Int -> Bool -> a -> a
@@ -18,59 +41,39 @@ class Elt a
 instance Elt a => Elt [a]
 
 type Array a = [a]
-data Segd = Segd { segd_lengths  :: [Int]
-                 , segd_indices  :: [Int]
-                 , segd_elements :: Int
-                 }
-
-data Sel2 = Sel2 { sel2_tags      :: [Tag]
-                 , sel2_indices   :: [Int]
-                 , sel2_elements0 :: Int
-                 , sel2_elements1 :: Int
-                 }
-
-type SelRep2 = ()
-
-
-length = P.length
-empty = []
-replicate = P.replicate
-repeat n _ xs = P.concat (replicate n xs)
-(!:) = (P.!!)
-extract xs i n = P.take n (P.drop i xs)
-drop = P.drop
-permute = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.permute"
-bpermute xs ns = map (xs !:) ns
-update = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.update"
-(+:+) = (P.++)
-
-mbpermute = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.mbpermute"
-bpermuteDft = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.bpermuteDft"
 
+data Segd 
+        = Segd 
+        { segd_lengths  :: [Int]
+        , segd_indices  :: [Int]
+        , segd_elements :: Int }
+
+data Sel2 
+        = Sel2 
+        { sel2_tags      :: [Tag]
+        , sel2_indices   :: [Int]
+        , sel2_elements0 :: Int
+        , sel2_elements1 :: Int }
+
+type SelRep2    = ()
+
+
+length          = P.length
+empty           = []
+replicate       = P.replicate
+repeat n _ xs   = P.concat (replicate n xs)
+(!:)            = (P.!!)
+extract xs i n  = P.take n (P.drop i xs)
+drop            = P.drop
+permute         = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.permute"
+bpermute xs ns  = map (xs !:) ns
+mbpermute       = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.mbpermute"
+bpermuteDft     = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.bpermuteDft"
+update          = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.update"
+(+:+)           = (P.++)
 interleave xs ys = P.concat [[x,y] | (x,y) <- P.zip xs ys]
 
-mkSel2 tags idxs n0 n1 _ = Sel2 tags idxs n0 n1
-tagsSel2 = sel2_tags
-indicesSel2 = sel2_indices
-elementsSel2_0 = sel2_elements0
-elementsSel2_1 = sel2_elements1
-repSel2 _ = ()
-
-mkSelRep2 _ = ()
-indicesSelRep2 tags _ = P.zipWith pick tags
-                      $ P.init
-                      $ P.scanl add (0,0) tags
-  where
-    pick 0 (i,j) = i
-    pick 1 (i,j) = j
-
-    add (i,j) 0 = (i+1,j)
-    add (i,j) 1 = (i,j+1)
-
-elementsSelRep2_0 tags _ = P.length [() | 0 <- tags]
-elementsSelRep2_1 tags _ = P.length [() | 1 <- tags]
-
-pack xs bs = [x | (x,b) <- P.zip xs bs, b]
+pack xs bs      = [x | (x,b) <- P.zip xs bs, b]
 
 combine [] [] [] = []
 combine (True  : bs) (x : xs) ys       = x : combine bs xs ys
@@ -82,38 +85,96 @@ combine2 tags _ xs ys = go tags xs ys
     go (0 : bs) (x : xs) ys = x : go bs xs ys
     go (1 : bs) xs (y : ys) = y : go bs xs ys
 
-map = P.map
-filter = P.filter
-zip = P.zip
-zip3 = P.zip3
-unzip = P.unzip
-unzip3 = P.unzip3
-fsts = map P.fst
-snds = map P.snd
-zipWith = P.zipWith
-
-fold = P.foldr -- or equivalently foldl
-fold1 = P.foldr1 -- or equivalently foldr1
-and = P.and
-sum = P.sum
-scan f z = P.init . P.scanl f z
-
-indices_s segd = P.concat [[0 .. n-1] | n <- segd_lengths segd] 
-indexed xs = zip [0 .. length xs - 1] xs
-enumFromTo m n = [m .. n]
-enumFromThenTo m n s = [m, n..s]
-
-enumFromStepLen i k 0 = []
-enumFromStepLen i k n = i : enumFromStepLen (i+k) k (n-1)
+map             = P.map
+filter          = P.filter
+zip             = P.zip
+zip3            = P.zip3
+unzip           = P.unzip
+unzip3          = P.unzip3
+fsts            = map P.fst
+snds            = map P.snd
+zipWith         = P.zipWith
+
+fold            = P.foldr
+fold1           = P.foldr1
+and             = P.and
+sum             = P.sum
+
+scan f z        = P.init . P.scanl f z
+
+indexed xs              = zip [0 .. length xs - 1] xs
+enumFromTo m n          = [m .. n]
+enumFromThenTo m n s    = [m, n..s]
+
+enumFromStepLen i k 0   = []
+enumFromStepLen i k n   = i : enumFromStepLen (i+k) k (n-1)
 
 enumFromStepLenEach size starts steps lens
   = ASSERT (size == sum lens)
-  P.concat
+    P.concat
   $ P.zipWith3 (\x y z -> P.enumFromThenTo x (x+y) (x+y*z)) starts steps lens
-  
 
-randoms n = P.take n . System.Random.randoms
-randomRs n r = P.take n . System.Random.randomRs r
+replicate_s segd xs
+        = P.concat
+        $ zipWith replicate (lengthsSegd segd) xs
+
+replicate_rs n xs
+        = P.concat
+        $ P.map (P.replicate n) xs
+
+append_s _ xd xs yd ys 
+        = P.concat (P.zipWith (P.++) (nest xd xs) (nest yd ys))
+
+fold_s  f z segd xs
+        = P.map (P.foldr f z) (nest segd xs)
+
+fold1_s f   segd xs
+        = P.map (P.foldr1 f)  (nest segd xs)
+
+fold_r  f z segSize xs 
+        = P.error "FIXME GABI PLEASE PLEASE PLEASE"
+
+sum_r segSize xs 
+        = P.error "FIXME GABI PLEASE PLEASE PLEASE" 
+
+indices_s segd
+        = P.concat [[0 .. n-1] | n <- segd_lengths segd] 
+
+lengthSegd      = length . lengthsSegd
+lengthsSegd     = segd_lengths
+indicesSegd     = segd_indices
+elementsSegd    = segd_elements
+mkSegd          = Segd
+
+
+mkSel2 tags idxs n0 n1 _ 
+        = Sel2 tags idxs n0 n1
+
+tagsSel2        = sel2_tags
+indicesSel2     = sel2_indices
+elementsSel2_0  = sel2_elements0
+elementsSel2_1  = sel2_elements1
+repSel2 _       = ()
+
+mkSelRep2 _     = ()
+
+indicesSelRep2 tags _ 
+  = P.zipWith pick tags
+  $ P.init
+  $ P.scanl add (0,0) tags
+  where
+    pick 0 (i,j) = i
+    pick 1 (i,j) = j
+
+    add (i,j) 0 = (i+1,j)
+    add (i,j) 1 = (i,j+1)
+
+elementsSelRep2_0 tags _ = P.length [() | 0 <- tags]
+elementsSelRep2_1 tags _ = P.length [() | 1 <- tags]
+
+randoms n       = P.take n . System.Random.randoms
+
+randomRs n r    = P.take n . System.Random.randomRs r
 
 nest :: Segd -> [a] -> [[a]]
 nest (Segd ns is _) xs = go ns xs
@@ -122,32 +183,12 @@ nest (Segd ns is _) xs = go ns xs
     go (n : ns) xs = let (ys, zs) = P.splitAt n xs
                      in ys : go ns zs
 
-replicate_s segd xs
-  = P.concat
-  $ zipWith replicate (lengthsSegd segd) xs
-replicate_rs n xs
-  = P.concat
-  $ P.map (P.replicate n) xs
-append_s _ xd xs yd ys = P.concat (P.zipWith (P.++) (nest xd xs) (nest yd ys))
-
-fold_s  f z segd xs = P.map (P.foldr f z) (nest segd xs)
-fold1_s f   segd xs = P.map (P.foldr1 f)  (nest segd xs)
-fold_r  f z segSize xs = P.error "FIXME GABI PLEASE PLEASE PLEASE"
-sum_r segSize xs = P.error "FIXME GABI PLEASE PLEASE PLEASE" 
-
-lengthSegd = length . lengthsSegd
-lengthsSegd = segd_lengths
-indicesSegd = segd_indices
-elementsSegd = segd_elements
-mkSegd = Segd
-
 class Elt a => IOElt a
-hPut = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.hPut"
-hGet = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.hGet"
-
-toList x = x
-fromList x = x
+hPut            = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.hPut"
+hGet            = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.hGet"
 
-toList_s x = x
-fromList_s x = x
+toList x        = x
+fromList x      = x
 
+toList_s x      = x
+fromList_s x    = x
index c28ba4d..72465cf 100644 (file)
@@ -41,8 +41,9 @@ filterUP f
         . splitD theGang unbalanced
 
 
--- | Extract all elements from an array according to a given flag array.
---   The two vectors should have the same length, but this is not checked.
+-- | Take elements of an array where a flag value is true, and pack them into
+--   the result. The souce and flag arrays should have the same length, 
+--   but this is not checked.
 packUP :: Unbox e => Vector e -> Vector Bool -> Vector e
 {-# INLINE_UP packUP #-}
 packUP xs flags 
index 70a9883..e91e060 100644 (file)
@@ -53,6 +53,7 @@ replicateRSUP :: Unbox a => Int -> Vector a -> Vector a
 {-# INLINE_UP replicateRSUP #-}
 replicateRSUP n xs = replicateSUP (lengthsToUPSegd (replicateUP (Seq.length xs) n)) xs
 
+
 appendSUP :: Unbox a => UPSegd -> UPSegd -> Vector a -> UPSegd -> Vector a -> Vector a
 {-# INLINE_UP appendSUP #-}
 appendSUP segd !xd !xs !yd !ys
@@ -65,6 +66,7 @@ appendSUP segd !xd !xs !yd !ys
                                (segdUPSegd yd) ys
                                (elementsUSegd segd) seg_off el_off
 
+
 appendSegS :: Unbox a => USegd -> Vector a -> USegd -> Vector a -> Int -> Int -> Int
                 -> S.Stream a
 {-# INLINE_STREAM appendSegS #-}
@@ -109,6 +111,7 @@ appendSegS !xd !xs !yd !ys !n seg_off el_off
           return $ Skip (Just (False, seg', i, j, xlens ! seg', n))
       | otherwise = return $ Yield (ys!j) (Just (True, seg, i, j+1, k-1, n-1))
 
+
 fixupFold :: Unbox a => (a -> a -> a) -> MVector s a
           -> Dist (Int,Vector a) -> ST s ()
 {-# NOINLINE fixupFold #-}
@@ -149,20 +152,22 @@ folds f g segd xs = dcarry `seq` drs `seq` runST (
         in
         ((k, Seq.take n rs), Seq.drop n rs)
 
+
 foldSUP :: Unbox a => (a -> a -> a) -> a -> UPSegd -> Vector a -> Vector a
 {-# INLINE foldSUP #-}
 foldSUP f !z = folds f (foldlSU f z)
 
+
 fold1SUP :: Unbox a => (a -> a -> a) -> UPSegd -> Vector a -> Vector a
 {-# INLINE fold1SUP #-}
 fold1SUP f = folds f (fold1SU f)
 
+
 sumSUP :: (Num e, Unbox e) => UPSegd -> Vector e -> Vector e
 {-# INLINE sumSUP #-}
 sumSUP = foldSUP (+) 0
 
 
-
 sumRUP :: (Num e, Unbox e) => Int -> Vector e -> Vector e
 {-# INLINE sumRUP #-}
 sumRUP = foldRUP (+) 0
@@ -179,6 +184,7 @@ foldRUP f z !segSize xs =
     noOfSegs = Seq.length xs `div` segSize
     dlen = splitLenD theGang noOfSegs
 
+
 indicesSUP :: UPSegd -> Vector Int
 {-# INLINE_UP indicesSUP #-}
 indicesSUP = joinD theGang balanced
index 33f6554..3fd8005 100644 (file)
@@ -18,7 +18,6 @@
 #include "fusion-phases.h"
 
 module Data.Array.Parallel.Unlifted.Parallel.UPSel (
-
   -- * Types
   UPSel2, UPSelRep2,
 
@@ -33,36 +32,58 @@ import Data.Array.Parallel.Unlifted.Sequential.USel
 import Data.Array.Parallel.Unlifted.Distributed
 import Data.Array.Parallel.Base (Tag, tagToInt)
 
-  -- (offset as :*: offset bs) :*: (length as :*: length bs)
-type UPSelRep2 = Dist ((Int,Int), (Int,Int))
-data UPSel2 = UPSel2 { upsel2_usel :: USel2
-                     , upsel2_rep  :: UPSelRep2
-                     }
 
+-- TODO: What is this for?
+type UPSelRep2
+        = Dist ((Int,Int), (Int,Int))
+
+-- TODO: What is this for?
+data UPSel2 
+        = UPSel2 
+        { upsel2_usel :: USel2
+        , upsel2_rep  :: UPSelRep2 }
+
+
+-- | O(1). Get the tags of a selector.
 tagsUPSel2 :: UPSel2 -> Vector Tag
 {-# INLINE tagsUPSel2 #-}
 tagsUPSel2 = tagsUSel2 .  upsel2_usel
 
+
+-- | O(1). Get the indices of a selector.
 indicesUPSel2 :: UPSel2 -> Vector Int
 {-# INLINE indicesUPSel2 #-}
 indicesUPSel2 = indicesUSel2 . upsel2_usel
 
+
+-- | O(1). TODO: What is this for?
 elementsUPSel2_0 :: UPSel2 -> Int
 {-# INLINE elementsUPSel2_0 #-}
 elementsUPSel2_0 = elementsUSel2_0 . upsel2_usel
 
+
+-- | O(1). TODO: What is this for?
 elementsUPSel2_1 :: UPSel2 -> Int
 {-# INLINE elementsUPSel2_1 #-}
 elementsUPSel2_1 = elementsUSel2_1 . upsel2_usel
 
+
+-- | O(1). TODO: What is this for?
 selUPSel2 :: UPSel2 -> USel2
 {-# INLINE selUPSel2 #-}
 selUPSel2 = upsel2_usel
 
+
+-- | O(1). TODO: What is this for?
 repUPSel2 :: UPSel2 -> UPSelRep2
 {-# INLINE repUPSel2 #-}
 repUPSel2 = upsel2_rep
 
+
+-- Representation selectors? --------------------------------------------------
+-- TODO: How are these different from the above?
+
+-- | TODO: What is this for?
 mkUPSelRep2 :: Vector Tag -> UPSelRep2
 {-# INLINE mkUPSelRep2 #-}
 mkUPSelRep2 tags = zipD idxs lens
@@ -78,6 +99,7 @@ mkUPSelRep2 tags = zipD idxs lens
 
     add (x1,y1) (x2,y2) = (x1+x2, y1+y2)
 
+
 indicesUPSelRep2 :: Vector Tag -> UPSelRep2 -> Vector Int
 {-# INLINE indicesUPSelRep2 #-}
 indicesUPSelRep2 tags rep = joinD theGang balanced
@@ -89,14 +111,20 @@ indicesUPSelRep2 tags rep = joinD theGang balanced
       = Seq.combine2ByTag tags (Seq.enumFromStepLen i 1 m)
                                (Seq.enumFromStepLen j 1 n)
 
+
+-- | O(n).
 elementsUPSelRep2_0 :: Vector Tag -> UPSelRep2 -> Int
 {-# INLINE elementsUPSelRep2_0 #-}
 elementsUPSelRep2_0 _ = sumD theGang . fstD . sndD
 
+
+-- | O(n).
 elementsUPSelRep2_1 :: Vector Tag -> UPSelRep2 -> Int
 {-# INLINE elementsUPSelRep2_1 #-}
 elementsUPSelRep2_1 _ = sumD theGang . sndD . sndD
 
+
+-- | O(1). Construct a selector. Wrapper for `UPSel2`.
 mkUPSel2 :: Vector Tag -> Vector Int -> Int -> Int -> UPSelRep2 -> UPSel2
 {-# INLINE mkUPSel2 #-}
 mkUPSel2 tags is n0 n1 rep = UPSel2 (mkUSel2 tags is n0 n1) rep
index ce0df44..79540a0 100644 (file)
@@ -18,7 +18,6 @@
 #include "fusion-phases.h"
 
 module Data.Array.Parallel.Unlifted.Sequential.USel (
-
   -- * Types
   USel2,
 
@@ -28,8 +27,6 @@ module Data.Array.Parallel.Unlifted.Sequential.USel (
 ) where
 
 import Data.Array.Parallel.Unlifted.Sequential.Vector as V
-
--- import Data.Array.Parallel.Stream ( mapAccumS )
 import qualified Data.Vector.Fusion.Stream as S
 import Data.Vector.Fusion.Stream.Monadic ( Stream(..) )
 import Data.Array.Parallel.Base (Tag)
@@ -40,30 +37,44 @@ data USel2 = USel2 { usel2_tags      :: !(Vector Tag)
                    , usel2_elements1 :: !Int
                    }
 
+
+-- | O(1). Get the number of elements represented by this selector.
 lengthUSel2 :: USel2 -> Int
 {-# INLINE lengthUSel2 #-}
 lengthUSel2 = V.length . usel2_tags
 
+
+-- | O(1). Get the tags of a selector.
 tagsUSel2 :: USel2 -> Vector Tag
 {-# INLINE tagsUSel2 #-}
 tagsUSel2 = usel2_tags
 
+
+-- | O(1). Get the indices of a selector.
 indicesUSel2 :: USel2 -> Vector Int
 {-# INLINE indicesUSel2 #-}
 indicesUSel2 = usel2_indices
 
+
+-- | O(1). TODO: What is this for?
 elementsUSel2_0 :: USel2 -> Int
 {-# INLINE elementsUSel2_0 #-}
 elementsUSel2_0 = usel2_elements0
 
+
+-- | O(1). TODO: What is this for?
 elementsUSel2_1 :: USel2 -> Int
 {-# INLINE elementsUSel2_1 #-}
 elementsUSel2_1 = usel2_elements1
 
+
+-- | O(1). Construct a selector. Alias for `USel2`
 mkUSel2 :: Vector Tag -> Vector Int -> Int -> Int -> USel2
 {-# INLINE mkUSel2 #-}
 mkUSel2 = USel2
 
+
+-- | TODO: What is this for?
 tagsToIndices2 :: Vector Tag -> Vector Int
 {-# INLINE tagsToIndices2 #-}
 tagsToIndices2 tags = unstream (mapAccumS add (0,0) (stream tags))
@@ -71,6 +82,7 @@ tagsToIndices2 tags = unstream (mapAccumS add (0,0) (stream tags))
     add (i,j) 0 = ((i+1,j),i)
     add (i,j) _ = ((i,j+1),j)
 
+
 mapAccumS :: (acc -> a -> (acc,b)) -> acc -> S.Stream a -> S.Stream b
 {-# INLINE_STREAM mapAccumS #-}
 mapAccumS f acc (Stream step s n) = Stream step' (acc,s) n
@@ -84,4 +96,3 @@ mapAccumS f acc (Stream step s n) = Stream step' (acc,s) n
                                         return $ S.Yield y (acc',s')
                         S.Skip    s' -> return $ S.Skip (acc,s')
                         S.Done       -> return S.Done
-