[commit: dph] : scanUP prelim fix. (21236cb)

[Ben Lippmeier]

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

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/21236cb2efd3959a86164e6e5612f07f8cef7228

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

commit 21236cb2efd3959a86164e6e5612f07f8cef7228
Author: George Roldugin <groldugin at cse.unsw.edu.au>
Date:   Mon May 9 16:30:31 2011 +1000

    scanUP prelim fix.

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

 .../Parallel/Unlifted/Parallel/Combinators.hs      |   18 +++++++++++++-----
 .../Array/Parallel/Unlifted/Sequential/Vector.hs   |    8 +-------
 2 files changed, 14 insertions(+), 12 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 72465cf..fe8284b 100644
--- a/dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/Combinators.hs
+++ b/dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/Combinators.hs
@@ -24,6 +24,7 @@ import Data.Array.Parallel.Unlifted.Sequential.Vector as Seq
 import Data.Array.Parallel.Unlifted.Distributed
 import Data.Array.Parallel.Unlifted.Parallel.UPSel
 
+import Debug.Trace (trace)
 
 -- | Apply a worker to all elements of a vector.
 mapUP :: (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
@@ -128,10 +129,17 @@ foldl1UP f arr
 
 
 -- | 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 
-        = splitJoinD theGang go
-        where   go xs = let (ds,zs) = unzipD $ mapD theGang (Seq.scanRes f z) xs
-                            zs'     = fst (scanD theGang f z zs)
-                        in  zipWithD theGang (Seq.map . f) zs' ds
+scanUP f z arr
+     | Seq.null arr = empty
+     | 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
+
diff --git a/dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Vector.hs b/dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Vector.hs
index 799fa37..ffb9c7e 100644
--- a/dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Vector.hs
+++ b/dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Vector.hs
@@ -37,7 +37,6 @@ module Data.Array.Parallel.Unlifted.Sequential.Vector (
   fold, fold1, fold1Maybe,
   scanl, scanl1,
   scan, scan1,
-  scanRes,
 
   -- * Searching
   elem, notElem,
@@ -276,6 +275,7 @@ fold1Maybe :: Unbox a => (a -> a -> a) -> Vector a -> Maybe a
 {-# INLINE_U fold1Maybe #-}
 fold1Maybe = foldl1Maybe
 
+
 -- |Prefix scan proceedings from left to right
 --
 scanl :: (Unbox a, Unbox b) => (b -> a -> b) -> b -> Vector a -> Vector b
@@ -302,12 +302,6 @@ scan1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a
 {-# INLINE_U scan1 #-}
 scan1 = scanl1
 
-scanRes :: Unbox a => (a -> a -> a) -> a -> Vector a -> (Vector a,a)
-{-# INLINE_U scanRes #-}
-scanRes f z xs = let ys = scanl' f z xs
-                 in
-                 (unsafeInit ys, unsafeLast ys)
-
 fsts :: (Unbox a, Unbox b) => Vector (a,b) -> Vector a
 {-# INLINE_STREAM fsts #-}
 fsts (VBase.V_2 _ xs ys) = xs