Replace strict pairs by normal lifted pairs in distributed types
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Wed, 9 Jun 2010 07:44:17 +0000 (07:44 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Wed, 9 Jun 2010 07:44:17 +0000 (07:44 +0000)
We use (a,b) instead of (a :*: b) in distributed types now. We will get rid of
(a :*: b) altogether once we move to vector so this is a change we'd have to
make anyway but happily, it also helps with performance a bit. In particular,
it allows us to trigger LiberateCase much less frequently.

dph-base/Data/Array/Parallel/Stream/Flat/Combinators.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Arrays.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Combinators.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types.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/UPSegd.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/UPSel.hs
dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Flat/Combinators.hs

index 4209dc8..aa8807b 100644 (file)
@@ -68,18 +68,18 @@ foldS f z (Stream next s _ c) = traceLoopEntry c' $ fold z s
 
     c' = "foldS" `sArgs` c
 
--- | Yield 'NothingS' if the 'Stream' is empty and fold it otherwise.
+-- | Yield 'Nothing' if the 'Stream' is empty and fold it otherwise.
 --
-fold1MaybeS :: Rebox a => (a -> a -> a) -> Stream a -> MaybeS a
+fold1MaybeS :: Rebox a => (a -> a -> a) -> Stream a -> Maybe a
 {-# INLINE_STREAM fold1MaybeS #-}
 fold1MaybeS f (Stream next s _ c) = traceLoopEntry c' $ fold0 s
   where
     fold0 s   = case next s of
-                  Done       -> traceLoopExit c' NothingS
+                  Done       -> traceLoopExit c' Nothing
                   Skip    s' -> s' `dseq` fold0 s'
                   Yield x s' -> s' `dseq` fold1 x s'
     fold1 z s = case next s of
-                  Done       -> traceLoopExit c' $ JustS z
+                  Done       -> traceLoopExit c' $ (z `dseq` Just z)
                   Skip    s' -> s' `dseq` z `dseq` fold1 z s'
                   Yield x s' -> let z' = f z x
                                 in s' `dseq` z' `dseq` fold1 z' s'
index c08f160..01db685 100644 (file)
@@ -75,7 +75,7 @@ splitLenD g n = generateD_cheap g len
     len i | i < m     = l+1
           | otherwise = l
 
-splitLenIdxD :: Gang -> Int -> Dist (Int :*: Int)
+splitLenIdxD :: Gang -> Int -> Dist (Int,Int)
 {-# INLINE splitLenIdxD #-}
 splitLenIdxD g n = generateD_cheap g len_idx
   where
@@ -84,8 +84,8 @@ splitLenIdxD g n = generateD_cheap g len_idx
     !m = n `remInt` p
 
     {-# INLINE [0] len_idx #-}
-    len_idx i | i < m     = l+1 :*: i*(l+1)
-              | otherwise = l   :*: i*l + m
+    len_idx i | i < m     = (l+1, i*(l+1))
+              | otherwise = (l,   i*l + m)
                                                
 
 -- | Distribute an array over a 'Gang' such that each threads gets the given
@@ -328,7 +328,7 @@ chunk !segd !di !dn is_last
 
     n' = left_len + (k'-k)
 
-splitSegdD' :: Gang -> USegd -> Dist (USegd :*: Int :*: Int)
+splitSegdD' :: Gang -> USegd -> Dist ((USegd,Int),Int)
 {-# INLINE splitSegdD' #-}
 splitSegdD' g !segd = imapD g mk
                          (splitLenIdxD g
@@ -336,8 +336,8 @@ splitSegdD' g !segd = imapD g mk
   where
     !p = gangSize g
 
-    mk i (dn :*: di) = case chunk segd di dn (i == p-1) of
-                         (# lens, l, o #) -> lengthsToUSegd lens :*: l :*: o
+    mk i (dn,di) = case chunk segd di dn (i == p-1) of
+                     (# lens, l, o #) -> ((lengthsToUSegd lens,l),o)
 
 joinSegD :: Gang -> Dist USegd -> USegd
 {-# INLINE_DIST joinSegD #-}
index 00d3b34..b43ecbf 100644 (file)
@@ -29,7 +29,7 @@ import Data.Array.Parallel.Base (
 import Data.Array.Parallel.Unlifted.Distributed.Gang (
   Gang, gangSize)
 import Data.Array.Parallel.Unlifted.Distributed.Types (
-  DT, Dist, indexD, zipD, unzipD, fstD, sndD,
+  DT, Dist, indexD, zipD, unzipD, fstD, sndD, deepSeqD,
   newMD, writeMD, unsafeFreezeMD,
   checkGangD, measureD)
 import Data.Array.Parallel.Unlifted.Distributed.DistST
@@ -45,12 +45,16 @@ generateD_cheap :: DT a => Gang -> (Int -> a) -> Dist a
 generateD_cheap g f = runDistST_seq g (myIndex >>= return . f)
 
 imapD :: (DT a, DT b) => Gang -> (Int -> a -> b) -> Dist a -> Dist b
-{-# NOINLINE imapD #-}
-imapD g f !d = checkGangD (here "imapD") g d
-               (runDistST g (do
-                               i <- myIndex
-                               x <- myD d
-                               return (f i x)))
+{-# INLINE [0] imapD #-}
+imapD g f d = imapD' g (\i x -> x `deepSeqD` f i x) d
+
+imapD' :: (DT a, DT b) => Gang -> (Int -> a -> b) -> Dist a -> Dist b
+{-# NOINLINE imapD' #-}
+imapD' g f !d = checkGangD (here "imapD") g d
+                (runDistST g (do
+                                i <- myIndex
+                                x <- myD d
+                                return (f i x)))
 
 -- | Map a function over a distributed value.
 mapD :: (DT a, DT b) => Gang -> (a -> b) -> Dist a -> Dist b
@@ -78,21 +82,19 @@ mapD g f !d = checkGangD (here "mapD") g d
 
 "zipD/imapD[1]" forall gang f xs ys.
   zipD (imapD gang f xs) ys
-    = imapD gang (\i -> unsafe_pairS . (\(x,y) -> (f i x, y)) . unsafe_unpairS)
-                 (zipD 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 -> unsafe_pairS . (\(x,y) -> (x, f i y)) . unsafe_unpairS)
-                 (zipD xs 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 -> unsafe_pairS (f i, x)) 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 -> unsafe_pairS (x, f i)) xs
+    = imapD gang (\i x -> (x, f i)) xs
 
   #-}
 
@@ -122,12 +124,12 @@ mapD g f !d = checkGangD (here "mapD") g d
 zipWithD :: (DT a, DT b, DT c)
          => Gang -> (a -> b -> c) -> Dist a -> Dist b -> Dist c
 {-# INLINE zipWithD #-}
-zipWithD g f dx dy = mapD g (uncurry f . unsafe_unpairS) (zipD dx dy)
+zipWithD g f dx dy = mapD g (uncurry f) (zipD dx dy)
 
 izipWithD :: (DT a, DT b, DT c)
           => Gang -> (Int -> a -> b -> c) -> Dist a -> Dist b -> Dist c
 {-# INLINE izipWithD #-}
-izipWithD g f dx dy = imapD g (\i -> uncurry (f i) . unsafe_unpairS) (zipD dx dy)
+izipWithD g f dx dy = imapD g (\i -> uncurry (f i)) (zipD dx dy)
 
 -- | Fold a distributed value.
 foldD :: DT a => Gang -> (a -> a -> a) -> Dist a -> a
@@ -182,19 +184,29 @@ mapAccumLD g f acc !d = checkGangD (here "mapAccumLD") g d $
 -- model andlead to a deadlock. Hence the bangs.
 
 mapDST_ :: DT a => Gang -> (a -> DistST s ()) -> Dist a -> ST s ()
-mapDST_ g p !d = checkGangD (here "mapDST_") g d $
-                 distST_ g (myD d >>= p)
+{-# INLINE mapDST_ #-}
+mapDST_ g p d = mapDST_' g (\x -> x `deepSeqD` p x) d
+
+mapDST_' :: DT a => Gang -> (a -> DistST s ()) -> Dist a -> ST s ()
+mapDST_' g p !d = checkGangD (here "mapDST_") g d $
+                  distST_ g (myD d >>= p)
 
 mapDST :: (DT a, DT b) => Gang -> (a -> DistST s b) -> Dist a -> ST s (Dist b)
-mapDST g p !d = checkGangD (here "mapDST_") g d $
-                distST g (myD d >>= p)
+{-# INLINE mapDST #-}
+mapDST g p !d = mapDST' g (\x -> x `deepSeqD` p x) d
+
+mapDST' :: (DT a, DT b) => Gang -> (a -> DistST s b) -> Dist a -> ST s (Dist b)
+mapDST' g p !d = checkGangD (here "mapDST_") g d $
+                 distST g (myD d >>= p)
 
 zipWithDST_ :: (DT a, DT b)
             => Gang -> (a -> b -> DistST s ()) -> Dist a -> Dist b -> ST s ()
-zipWithDST_ g p !dx !dy = mapDST_ g (uncurryS p) (zipD dx dy)
+{-# INLINE zipWithDST_ #-}
+zipWithDST_ g p !dx !dy = mapDST_ g (uncurry p) (zipD dx dy)
 
 zipWithDST :: (DT a, DT b, DT c)
            => Gang
            -> (a -> b -> DistST s c) -> Dist a -> Dist b -> ST s (Dist c)
-zipWithDST g p !dx !dy = mapDST g (uncurryS p) (zipD dx dy)
+{-# INLINE zipWithDST #-}
+zipWithDST g p !dx !dy = mapDST g (uncurry p) (zipD dx dy)
 
index 2365319..c34e983 100644 (file)
@@ -23,6 +23,8 @@ module Data.Array.Parallel.Unlifted.Distributed.Types (
   -- * Operations on immutable distributed types
   indexD, unitD, zipD, unzipD, fstD, sndD, lengthD,
   newD,
+  zipSD, unzipSD, fstSD, sndSD,
+  deepSeqD,
 
   lengthUSegdD, lengthsUSegdD, indicesUSegdD, elementsUSegdD,
 
@@ -79,6 +81,9 @@ class DT a where
   -- | Unsafely freeze a mutable distributed value.
   unsafeFreezeMD :: MDist a s             -> ST s (Dist a)
 
+  deepSeqD       :: a -> b -> b
+  deepSeqD = seq
+
   -- | Number of elements in the distributed value. This is for debugging
   -- only.
   sizeD :: Dist a -> Int
@@ -90,8 +95,8 @@ class DT a where
   measureD :: a -> String
   measureD _ = "?"
 
--- Distributing hyperstrict types may not change their strictness.
-instance (HS a, DT a) => HS (Dist a)
+-- Distributed values must always be hyperstrict.
+instance DT a => HS (Dist a)
 
 -- | Check that the sizes of the 'Gang' and of the distributed value match.
 checkGangD :: DT a => String -> Gang -> Dist a -> b -> b
@@ -272,23 +277,74 @@ instance DT Double where
   sizeD          = primSizeD
   sizeMD         = primSizeMD
 
-instance (DT a, DT b) => DT (a :*: b) where
-  data Dist  (a :*: b)   = DProd  !(Dist a)    !(Dist b)
-  data MDist (a :*: b) s = MDProd !(MDist a s) !(MDist b s)
+instance (DT a, DT b) => DT (a,b) where
+  data Dist  (a,b)   = DProd  !(Dist a)    !(Dist b)
+  data MDist (a,b) s = MDProd !(MDist a s) !(MDist b s)
 
-  indexD d i               = (fstD d `indexD` i) :*: (sndD d `indexD` i)
+  indexD d i               = (fstD d `indexD` i,sndD d `indexD` i)
   newMD g                  = liftM2 MDProd (newMD g) (newMD g)
-  readMD  (MDProd xs ys) i = liftM2 (:*:) (readMD xs i) (readMD ys i)
-  writeMD (MDProd xs ys) i (x :*: y)
+  readMD  (MDProd xs ys) i = liftM2 (,) (readMD xs i) (readMD ys i)
+  writeMD (MDProd xs ys) i (x,y)
                             = writeMD xs i x >> writeMD ys i y
   unsafeFreezeMD (MDProd xs ys)
                             = liftM2 DProd (unsafeFreezeMD xs)
                                            (unsafeFreezeMD ys)
+
+  {-# INLINE deepSeqD #-}
+  deepSeqD (x,y) z = deepSeqD x (deepSeqD y z)
+
   sizeD  (DProd  x _) = sizeD  x
   sizeMD (MDProd x _) = sizeMD x
 
-  measureD (x :*: y) = "(" ++ measureD x ++ "," ++ measureD y ++ ")"
+  measureD (x,y) = "(" ++ measureD x ++ "," ++ measureD y ++ ")"
+
+instance DT a => DT (Maybe a) where
+  data Dist  (Maybe a)   = DMaybe  !(Dist  Bool)   !(Dist  a)
+  data MDist (Maybe a) s = MDMaybe !(MDist Bool s) !(MDist a s)
+
+  indexD (DMaybe bs as) i
+    | bs `indexD` i       = Just $ as `indexD` i
+    | otherwise           = Nothing
+  newMD g = liftM2 MDMaybe (newMD g) (newMD g)
+  readMD (MDMaybe bs as) i =
+    do
+      b <- readMD bs i
+      if b then liftM Just $ readMD as i
+           else return Nothing
+  writeMD (MDMaybe bs as) i Nothing  = writeMD bs i False
+  writeMD (MDMaybe bs as) i (Just x) = writeMD bs i True
+                                     >> writeMD as i x
+  unsafeFreezeMD (MDMaybe bs as) = liftM2 DMaybe (unsafeFreezeMD bs)
+                                                 (unsafeFreezeMD as)
+
+  {-# INLINE deepSeqD #-}
+  deepSeqD Nothing  z = z
+  deepSeqD (Just x) z = deepSeqD x z
+
+  sizeD  (DMaybe  b _) = sizeD  b
+  sizeMD (MDMaybe b _) = sizeMD b
 
+  measureD Nothing = "Nothing"
+  measureD (Just x) = "Just (" ++ measureD x ++ ")"
+
+instance (DT a, DT b) => DT (a :*: b) where
+  data Dist  (a :*: b)   = SDProd  !(Dist a)    !(Dist b)
+  data MDist (a :*: b) s = MSDProd !(MDist a s) !(MDist b s)
+
+  indexD d i                = (fstSD d `indexD` i) :*: (sndSD d `indexD` i)
+  newMD g                   = liftM2 MSDProd (newMD g) (newMD g)
+  readMD  (MSDProd xs ys) i = liftM2 (:*:) (readMD xs i) (readMD ys i)
+  writeMD (MSDProd xs ys) i (x :*: y)
+                            = writeMD xs i x >> writeMD ys i y
+  unsafeFreezeMD (MSDProd xs ys)
+                            = liftM2 SDProd (unsafeFreezeMD xs)
+                                            (unsafeFreezeMD ys)
+  sizeD  (SDProd  x _) = sizeD  x
+  sizeMD (MSDProd x _) = sizeMD x
+
+  measureD (x :*: y) = "(" ++ measureD x ++ ":*:" ++ measureD y ++ ")"
+
+{-
 instance DT a => DT (MaybeS a) where
   data Dist  (MaybeS a)   = DMaybe  !(Dist  Bool)   !(Dist  a)
   data MDist (MaybeS a) s = MDMaybe !(MDist Bool s) !(MDist a s)
@@ -312,6 +368,7 @@ instance DT a => DT (MaybeS a) where
 
   measureD NothingS = "Nothing"
   measureD (JustS x) = "Just (" ++ measureD x ++ ")"
+-}
 
 instance UA a => DT (UArr a) where
   data Dist  (UArr a)   = DUArr  !(Dist  Int)   !(BBArr    (UArr a))
@@ -353,6 +410,11 @@ instance DT USegd where
           = liftM3 DUSegd (unsafeFreezeMD lens)
                           (unsafeFreezeMD idxs)
                           (unsafeFreezeMD eles)
+
+  deepSeqD segd z = deepSeqD (lengthsUSegd  segd)
+                  $ deepSeqD (indicesUSegd  segd)
+                  $ deepSeqD (elementsUSegd segd) z
+
   sizeD  (DUSegd  _ _ eles) = sizeD eles
   sizeMD (MDUSegd _ _ eles) = sizeMD eles
 
@@ -392,25 +454,47 @@ unitD = DUnit . gangSize
 
 -- | 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)
+zipD :: (DT a, DT b) => Dist a -> Dist b -> Dist (a,b)
 {-# INLINE [0] zipD #-}
 zipD !x !y = checkEq (here "zipDT") "Size mismatch" (sizeD x) (sizeD y) $
              DProd x y
 
 -- | Unpairing of distributed values.
-unzipD :: (DT a, DT b) => Dist (a :*: b) -> Dist a :*: Dist b
+unzipD :: (DT a, DT b) => Dist (a,b) -> (Dist a, Dist b)
 {-# INLINE_DIST unzipD #-}
-unzipD (DProd dx dy) = dx :*: dy
+unzipD (DProd dx dy) = (dx,dy)
 
 -- | Extract the first elements of a distributed pair.
-fstD :: (DT a, DT b) => Dist (a :*: b) -> Dist a
+fstD :: (DT a, DT b) => Dist (a,b) -> Dist a
 {-# INLINE_DIST fstD #-}
-fstD = fstS . unzipD
+fstD = fst . unzipD
 
 -- | Extract the second elements of a distributed pair.
-sndD :: (DT a, DT b) => Dist (a :*: b) -> Dist b
+sndD :: (DT a, DT b) => Dist (a,b) -> Dist b
 {-# INLINE_DIST sndD #-}
-sndD = sndS . unzipD
+sndD = snd . unzipD
+
+-- | Pairing of distributed values.
+-- /The two values must belong to the same/ 'Gang'.
+zipSD :: (DT a, DT b) => Dist a -> Dist b -> Dist (a :*: b)
+{-# INLINE [0] zipSD #-}
+zipSD !x !y = checkEq (here "zipSD") "Size mismatch" (sizeD x) (sizeD y) $
+              SDProd x y
+
+-- | Unpairing of distributed values.
+unzipSD :: (DT a, DT b) => Dist (a :*: b) -> (Dist a, Dist b)
+{-# INLINE_DIST unzipSD #-}
+unzipSD (SDProd dx dy) = (dx,dy)
+
+-- | Extract the first elements of a distributed pair.
+fstSD :: (DT a, DT b) => Dist (a :*: b) -> Dist a
+{-# INLINE_DIST fstSD #-}
+fstSD = fst . unzipSD
+
+-- | Extract the second elements of a distributed pair.
+sndSD :: (DT a, DT b) => Dist (a :*: b) -> Dist b
+{-# INLINE_DIST sndSD #-}
+sndSD = snd . unzipSD
 
 -- | Yield the distributed length of a distributed array.
 lengthD :: UA a => Dist (UArr a) -> Dist Int
index a9b42a9..9053175 100644 (file)
@@ -75,8 +75,8 @@ combine2UP tags rep !xs !ys = joinD theGang balanced
                             $ zipWithD theGang go rep
                             $ splitD theGang balanced tags
   where
-    go ((i :*: j) :*: (m :*: n)) ts = combine2ByTagU ts (sliceU xs i m)
-                                                        (sliceU ys j n)
+    go ((i,j), (m,n)) ts = combine2ByTagU ts (sliceU xs i m)
+                                             (sliceU ys j n)
     
 {-
 combine2UP sel !xs !ys = zipWithUP get (tagsUSel2 sel) (indicesUSel2 sel)
@@ -153,23 +153,23 @@ fold1UP = foldl1UP
 
 foldl1UP :: (DT a, UA a) => (a -> a -> a) -> UArr a -> a
 {-# INLINE_U foldl1UP #-}
-foldl1UP f arr = (maybeS z (f z)
+foldl1UP f arr = (maybe z (f z)
            . foldD  theGang combine
            . mapD   theGang (foldl1MaybeU f)
            . splitD theGang unbalanced) arr
   where
     z = arr !: 0
-    combine (JustS x) (JustS y) = JustS (f x y)
-    combine (JustS x) NothingS  = JustS x
-    combine NothingS  (JustS y) = JustS y
-    combine NothingS  NothingS  = NothingS
+    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
 
 scanUP :: (DT a, UA a) => (a -> a -> a) -> a -> UArr a -> UArr a
 {-# INLINE_UP scanUP #-}
 scanUP f z = splitJoinD theGang go
   where
-    go xs = let ds :*: zs = unzipD $ mapD theGang (scanResU f z) xs
-                zs'       = fstS (scanD theGang f z zs)
+    go xs = let (ds,zs) = unzipD $ mapD theGang (unsafe_unpairS . scanResU f z) xs
+                zs'     = fstS (scanD theGang f z zs)
             in
             zipWithD theGang (mapU . f) zs' ds
 
index 6ba0c5c..c8bc56f 100644 (file)
@@ -57,7 +57,7 @@ enumFromStepLenUP start delta len =
   (mapD theGang gen
   (splitLenIdxD theGang len))
   where
-    gen (n :*: i) = enumFromStepLenU (i * delta + start) delta n
+    gen (n,i) = enumFromStepLenU (i * delta + start) delta n
     --dlen = splitLenD theGang len
     --is   = fstS (scanD theGang (+) 0 dlen)
     --
index b38426a..a1235ec 100644 (file)
@@ -53,11 +53,14 @@ replicateSUP segd !xs = joinD theGang balanced
                       . mapD theGang rep
                       $ distUPSegd segd
   where
-    rep (dsegd :*: di :*: _)
+    rep ((dsegd,di),_)
+      = replicateSU dsegd (sliceU xs di (lengthUSegd dsegd))
+
+{-
       = bpermuteU xs
       . unstreamU
       $ indicesSegdS (lengthsUSegd dsegd) di (elementsUSegd dsegd)
-    
+-}
 
 indicesSegdS :: UArr Int -> Int -> Int -> Stream Int
 {-# INLINE_STREAM indicesSegdS #-}
@@ -83,7 +86,7 @@ appendSUP segd !xd !xs !yd !ys
   . mapD theGang append
   $ distUPSegd segd
   where
-    append (segd :*: seg_off :*: el_off)
+    append ((segd,seg_off),el_off)
       = unstreamU $ appendSegS (segdUPSegd xd) xs
                                (segdUPSegd yd) ys
                                (elementsUSegd segd) seg_off el_off
@@ -202,7 +205,7 @@ foldlSUP f z segd xs = joinD theGang unbalanced
 -}
 
 fixupFold :: UA a => (a -> a -> a) -> MUArr a s
-          -> Dist (Int :*: UArr a) -> ST s ()
+          -> Dist (Int,UArr a) -> ST s ()
 {-# NOINLINE fixupFold #-}
 fixupFold f !mrs !dcarry = go 1
   where
@@ -215,7 +218,7 @@ fixupFold f !mrs !dcarry = go 1
                            writeMU mrs k (f x (c !: 0))
                            go (i+1)
       where
-        k :*: c = indexD dcarry i
+        (k,c) = indexD dcarry i
 
 
 folds :: UA a => (a -> a -> a)
@@ -227,18 +230,18 @@ folds f g segd xs = dcarry `seq` drs `seq` runST (
     fixupFold f mrs dcarry
     unsafeFreezeAllMU mrs)
   where
-    dcarry :*: drs
+    (dcarry,drs)
           = unzipD
-          $ mapD theGang (partial . unsafe_unpairS)
+          $ mapD theGang partial
           $ zipD (distUPSegd segd)
                  (splitD theGang balanced xs)
 
-    partial (segd :*: k :*: off, as)
+    partial (((segd,k),off), as)
       = let rs = g segd as
         in
         rs `seq`
-        if off == 0 then k :*: emptyU :*: rs
-                    else k :*: takeU 1 rs :*: dropU 1 rs
+        if off == 0 then ((k, emptyU),     rs)
+                    else ((k, takeU 1 rs), dropU 1 rs)
 
 
 foldSUP :: UA a => (a -> a -> a) -> a -> UPSegd -> UArr a -> UArr a
@@ -285,5 +288,5 @@ indicesSUP = joinD theGang balanced
            . mapD theGang indices
            . distUPSegd
   where
-    indices (segd :*: k :*: off) = indicesSU' off segd
+    indices ((segd,k),off) = indicesSU' off segd
 
index 0708cba..f6a7892 100644 (file)
@@ -33,7 +33,7 @@ import Data.Array.Parallel.Unlifted.Distributed
 import Data.Array.Parallel.Base ((:*:))
 
 data UPSegd = UPSegd { upsegd_usegd :: !USegd
-                     , upsegd_dsegd :: Dist (USegd :*: Int :*: Int)
+                     , upsegd_dsegd :: Dist ((USegd,Int),Int)
                      }
 
 lengthUPSegd :: UPSegd -> Int
@@ -56,7 +56,7 @@ segdUPSegd :: UPSegd -> USegd
 {-# INLINE segdUPSegd #-}
 segdUPSegd = upsegd_usegd
 
-distUPSegd :: UPSegd -> Dist (USegd :*: Int :*: Int)
+distUPSegd :: UPSegd -> Dist ((USegd,Int),Int)
 {-# INLINE distUPSegd #-}
 distUPSegd = upsegd_dsegd
 
index f0fb765..fcf0513 100644 (file)
@@ -33,7 +33,7 @@ import Data.Array.Parallel.Unlifted.Distributed
 import Data.Array.Parallel.Base ((:*:)(..), fstS)
 
   -- (offset as :*: offset bs) :*: (length as :*: length bs)
-type UPSelRep2 = Dist ((Int :*: Int) :*: (Int :*: Int))
+type UPSelRep2 = Dist ((Int,Int), (Int,Int))
 data UPSel2 = UPSel2 { upsel2_usel :: USel2
                      , upsel2_rep  :: UPSelRep2
                      }
@@ -70,12 +70,12 @@ mkUPSelRep2 tags = zipD idxs lens
          $ splitD theGang balanced tags
 
     idxs = fstS
-         $ scanD theGang add (0 :*: 0) lens
+         $ scanD theGang add (0,0) lens
 
     count bs = let ones = sumU bs
-               in (lengthU bs - ones) :*: ones
+               in (lengthU bs - ones,ones)
 
-    add (x1 :*: y1) (x2 :*: y2) = (x1+x2) :*: (y1+y2)
+    add (x1,y1) (x2,y2) = (x1+x2, y1+y2)
 
 indicesUPSelRep2 :: UArr Int -> UPSelRep2 -> UArr Int
 {-# INLINE indicesUPSelRep2 #-}
@@ -84,7 +84,7 @@ indicesUPSelRep2 tags rep = joinD theGang balanced
                                              (splitD theGang balanced tags)
                                               rep
   where
-    indices tags ((i :*: j) :*: (m :*: n))
+    indices tags ((i,j), (m,n))
       = combine2ByTagU tags (enumFromStepLenU i 1 m)
                             (enumFromStepLenU j 1 n)
 
index 57db7ce..db997f1 100644 (file)
@@ -95,7 +95,7 @@ foldl1U :: UA a => (a -> a -> a) -> UArr a -> a
 foldl1U f arr = checkNotEmpty (here "foldl1U") (lengthU arr) $
                 foldlU f (arr !: 0) (sliceU arr 1 (lengthU arr - 1))
 
-foldl1MaybeU :: UA a => (a -> a -> a) -> UArr a -> MaybeS a
+foldl1MaybeU :: UA a => (a -> a -> a) -> UArr a -> Maybe a
 {-# INLINE_U foldl1MaybeU #-}
 foldl1MaybeU f = fold1MaybeS f . streamU
 
@@ -106,7 +106,7 @@ foldU :: UA a => (a -> a -> a) -> a -> UArr a -> a
 {-# INLINE_U foldU #-}
 foldU = foldlU
 
-fold1MaybeU :: UA a => (a -> a -> a) -> UArr a -> MaybeS a
+fold1MaybeU :: UA a => (a -> a -> a) -> UArr a -> Maybe a
 {-# INLINE_U fold1MaybeU #-}
 fold1MaybeU = foldl1MaybeU