[commit: dph] master: Fix scanUP. (bab79ee)

[Ben Lippmeier]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/dph

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/bab79eedb285813ba7ee9a5fee7839f88424b02e

>---------------------------------------------------------------

commit bab79eedb285813ba7ee9a5fee7839f88424b02e
Author: George Roldugin <groldugin at cse.unsw.edu.au>
Date:   Tue May 17 18:01:31 2011 +1000

    Fix scanUP.

>---------------------------------------------------------------

 .../Parallel/Unlifted/Parallel/Combinators.hs      |   35 +++++++++----------
 1 files changed, 17 insertions(+), 18 deletions(-)

diff --git a/dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/Combinators.hs b/dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/Combinators.hs
index e14d14e..8f9c682 100644
--- a/dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/Combinators.hs
+++ b/dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/Combinators.hs
@@ -92,14 +92,9 @@ foldUP :: (DT a, Unbox a) => (a -> a -> a) -> a -> Vector a -> a
 {-# INLINE foldUP #-}
 foldUP f !z arr
         = (maybe z (f z)
-        . foldD  theGang combine
+        . foldD  theGang (maybeApp f)
         . mapD   theGang (Seq.fold1Maybe f)
         . splitD theGang unbalanced) arr
-        where
-                combine (Just x) (Just y) = Just (f x y)
-                combine (Just x) Nothing  = Just x
-                combine Nothing  (Just y) = Just y
-                combine Nothing  Nothing  = Nothing
 
 
 -- | Array reduction proceeding from the left (requires associative combination)
@@ -121,20 +116,12 @@ foldl1UP :: (DT a, Unbox a) => (a -> a -> a) -> Vector a -> a
 {-# INLINE_U foldl1UP #-}
 foldl1UP f arr
         = (fromJust
-        . foldD  theGang combine
+        . foldD  theGang (maybeApp f)
         . mapD   theGang (Seq.foldl1Maybe f)
         . splitD theGang unbalanced) arr
-        where
-                combine (Just x) (Just y) = Just (f x y)
-                combine (Just x) Nothing  = Just x
-                combine Nothing  (Just y) = Just y
-                combine Nothing  Nothing  = Nothing
 
 
 -- | Prefix scan. Similar to fold, but produce an array of the intermediate states.

>---------------------------------------------------------------

---   TODO: Fails with EU > length xs

>---------------------------------------------------------------

 scanUP :: (DT a, Unbox a) => (a -> a -> a) -> a -> Vector a -> Vector a
 {-# INLINE_UP scanUP #-}
 scanUP f z arr
@@ -142,7 +129,19 @@ scanUP f z arr
      | otherwise    = splitJoinD theGang go arr
      where
        {-# INLINE go #-}
-       go xs = let zs  = mapD theGang (Seq.fold1 f) xs
-                   zs' = fst (scanD theGang f z zs)
-               in  zipWithD theGang (Seq.scan f) zs' xs
+       go xs = let zs  = mapD theGang (Seq.fold1Maybe f) xs           -- compute fold1 of every array chunk
+                   zs' = fst (scanD theGang (maybeApp f) (Just z) zs) -- compute initial value for every chunk
+               in  zipWithD theGang scanMaybe zs' xs                  -- scan using precomputed initial values
+       scanMaybe (Just z) xs = Seq.scan f z xs
+       scanMaybe Nothing  _  = empty                                  -- no chunk for this gang thread
+       
+       
+-- | Internal helper function to facilitate applying scans and folds over 
+-- | gang threads that potentially have no local value 
+maybeApp :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
+{-# INLINE maybeApp #-}
+maybeApp f (Just x) (Just y) = Just (f x y)
+maybeApp _ (Just x) Nothing  = Just x
+maybeApp _ Nothing  (Just y) = Just y
+maybeApp _ Nothing  Nothing  = Nothing