Remove SUArr
[packages/dph.git] / dph-prim-par / Data / Array / Parallel / Unlifted / Parallel / Combinators.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Data.Array.Parallel.Unlifted.Parallel.Combinators
4 -- Copyright : (c) 2006 Roman Leshchinskiy
5 -- License : see libraries/ndp/LICENSE
6 --
7 -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>
8 -- Stability : experimental
9 -- Portability : portable
10 --
11 -- Description ---------------------------------------------------------------
12 --
13 -- Parallel combinators for unlifted arrays
14 --
15
16 {-# LANGUAGE CPP #-}
17
18 #include "fusion-phases.h"
19
20 module Data.Array.Parallel.Unlifted.Parallel.Combinators (
21 mapUP, filterUP, packUP, combineUP, zipWithUP, foldUP, fold1UP, foldl1UP,
22 scanUP
23 ) where
24
25 import Data.Array.Parallel.Base
26 import Data.Array.Parallel.Unlifted.Sequential
27 import Data.Array.Parallel.Unlifted.Distributed
28
29 mapUP :: (UA a, UA b) => (a -> b) -> UArr a -> UArr b
30 {-# INLINE mapUP #-}
31 mapUP f = splitJoinD theGang (mapD theGang (mapU f))
32
33 filterUP :: UA a => (a -> Bool) -> UArr a -> UArr a
34 {-# INLINE filterUP #-}
35 filterUP f = joinD theGang unbalanced
36 . mapD theGang (filterU f)
37 . splitD theGang unbalanced
38
39
40
41 -- |Extract all elements from an array according to a given flag array
42 --
43 packUP:: UA e => UArr e -> UArr Bool -> UArr e
44 {-# INLINE_UP packUP #-}
45 packUP xs flags = fstU . filterUP sndS $ zipU xs flags
46
47 combineUP :: UA a => UArr Bool -> UArr a -> UArr a -> UArr a
48 {-# INLINE_UP combineUP #-}
49 combineUP flags !xs !ys = joinD theGang balanced
50 . zipWithD theGang go (zipD is ns)
51 $ splitD theGang balanced flags
52 where
53 ns = mapD theGang count
54 $ splitD theGang balanced flags
55
56 is = fstS $ scanD theGang add (0 :*: 0) ns
57
58 count bs = let ts = sumU (mapU fromBool bs)
59 in ts :*: (lengthU bs - ts)
60
61 add (x1 :*: y1) (x2 :*: y2) = (x1 + x2) :*: (y1 + y2)
62
63 go ((i :*: j) :*: (m :*: n)) bs = combineU bs (sliceU xs i m) (sliceU ys j n)
64
65
66 zipWithUP :: (UA a, UA b, UA c) => (a -> b -> c) -> UArr a -> UArr b -> UArr c
67 {-# INLINE zipWithUP #-}
68 zipWithUP f xs ys = splitJoinD theGang (mapD theGang (mapU (uncurryS f))) (zipU xs ys)
69 {-
70 zipWithUP f a b = joinD theGang balanced
71 (zipWithD theGang (zipWithU f)
72 (splitD theGang balanced a)
73 (splitD theGang balanced b))
74 -}
75 --zipWithUP f a b = mapUP (uncurryS f) (zipU a b)
76
77 foldUP :: (UA a, DT a) => (a -> a -> a) -> a -> UArr a -> a
78 {-# INLINE foldUP #-}
79 foldUP f z = maybeS z (f z)
80 . foldD theGang combine
81 . mapD theGang (foldl1MaybeU f)
82 . splitD theGang unbalanced
83 where
84 combine (JustS x) (JustS y) = JustS (f x y)
85 combine (JustS x) NothingS = JustS x
86 combine NothingS (JustS y) = JustS y
87 combine NothingS NothingS = NothingS
88
89
90 -- |Array reduction proceeding from the left (requires associative combination)
91 --
92 foldlUP :: (DT a, UA a) => (a -> a -> a) -> a -> UArr a -> a
93 {-# INLINE_UP foldlUP #-}
94 foldlUP f z arr
95 | nullU arr = z
96 | otherwise = foldl1UP f arr
97
98 -- |Reduction of a non-empty array which requires an associative combination
99 -- function
100 --
101 fold1UP :: (DT a, UA a) => (a -> a -> a) -> UArr a -> a
102 {-# INLINE fold1UP #-}
103 fold1UP = foldl1UP
104
105
106
107 foldl1UP :: (DT a, UA a) => (a -> a -> a) -> UArr a -> a
108 {-# INLINE_U foldl1UP #-}
109 foldl1UP f arr = (maybeS z (f z)
110 . foldD theGang combine
111 . mapD theGang (foldl1MaybeU f)
112 . splitD theGang unbalanced) arr
113 where
114 z = arr !: 0
115 combine (JustS x) (JustS y) = JustS (f x y)
116 combine (JustS x) NothingS = JustS x
117 combine NothingS (JustS y) = JustS y
118 combine NothingS NothingS = NothingS
119
120 scanUP :: (DT a, UA a) => (a -> a -> a) -> a -> UArr a -> UArr a
121 {-# INLINE_UP scanUP #-}
122 scanUP f z = splitJoinD theGang go
123 where
124 go xs = let ds :*: zs = unzipD $ mapD theGang (scanResU f z) xs
125 zs' = fstS (scanD theGang f z zs)
126 in
127 zipWithD theGang (mapU . f) zs' ds
128
129