Extract dph-prim-par
[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, 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
48 zipWithUP :: (UA a, UA b, UA c) => (a -> b -> c) -> UArr a -> UArr b -> UArr c
49 {-# INLINE zipWithUP #-}
50 zipWithUP f a b = joinD theGang balanced
51 $ zipWithD theGang (zipWithU f)
52 (splitD theGang balanced a)
53 (splitD theGang balanced b)
54 --zipWithUP f a b = mapUP (uncurryS f) (zipU a b)
55
56 foldUP :: (UA a, DT a) => (a -> a -> a) -> a -> UArr a -> a
57 {-# INLINE foldUP #-}
58 foldUP f z = maybeS z (f z)
59 . foldD theGang combine
60 . mapD theGang (foldl1MaybeU f)
61 . splitD theGang unbalanced
62 where
63 combine (JustS x) (JustS y) = JustS (f x y)
64 combine (JustS x) NothingS = JustS x
65 combine NothingS (JustS y) = JustS y
66 combine NothingS NothingS = NothingS
67
68
69 -- |Array reduction proceeding from the left (requires associative combination)
70 --
71 foldlUP :: (DT a, UA a) => (a -> a -> a) -> a -> UArr a -> a
72 {-# INLINE_UP foldlU #-}
73 foldlUP f z arr
74 | nullU arr = z
75 | otherwise = foldl1UP f arr
76
77 -- |Reduction of a non-empty array which requires an associative combination
78 -- function
79 --
80 fold1UP :: (DT a, UA a) => (a -> a -> a) -> UArr a -> a
81 {-# INLINE fold1UP #-}
82 fold1UP = foldl1UP
83
84
85
86 foldl1UP :: (DT a, UA a) => (a -> a -> a) -> UArr a -> a
87 {-# INLINE_U foldl1UP #-}
88 foldl1UP f arr = (maybeS z (f z)
89 . foldD theGang combine
90 . mapD theGang (foldl1MaybeU f)
91 . splitD theGang unbalanced) arr
92 where
93 z = arr !: 0
94 combine (JustS x) (JustS y) = JustS (f x y)
95 combine (JustS x) NothingS = JustS x
96 combine NothingS (JustS y) = JustS y
97 combine NothingS NothingS = NothingS
98
99 scanUP :: (DT a, UA a) => (a -> a -> a) -> a -> UArr a -> UArr a
100 {-# INLINE_UP scanUP #-}
101 scanUP f z = splitJoinD theGang go
102 where
103 go xs = let ds :*: zs = unzipD $ mapD theGang (scanResU f z) xs
104 zs' = fstS (scanD theGang f z zs)
105 in
106 zipWithD theGang (mapU . f) zs' ds
107
108