dph-prim-*: add updateVSegsReachable for when we know the result covers all psegs
[packages/dph.git] / dph-prim-par / Data / Array / Parallel / Unlifted.hs
1 {-# LANGUAGE PackageImports, CPP, NoMonomorphismRestriction #-}
2
3 -- | Primitive parallel combinators that work on flat, unlifted arrays.
4 -- Some of them don't actually have parallel implementations, so we bail out
5 -- to the regular sequential ones.
6 --
7 -- This set of combinators is used when the program is comiled with @-fdph-par@.
8 -- When compiling with @-fdph-seq@, the ones in the @dph-prim-seq@ package are used
9 -- instead. The @dph-prim-seq package@ exports the same names, but all combinators
10 -- are implemented sequentially.
11 --
12 -- The API is defined in @DPH_Header.h@ and @DPH_Interface.h@ to ensure that both
13 -- @dph-prim-par@ and @dph-prim-seq@ really do export the same symbols.
14
15 #include "DPH_Header.h"
16
17 import Data.Array.Parallel.Unlifted.Parallel
18 import Data.Array.Parallel.Base.TracePrim
19 import Data.Array.Parallel.Unlifted.Distributed ( DT )
20
21 import Data.Array.Parallel.Unlifted.Parallel.UPSel
22 import qualified Data.Array.Parallel.Unlifted.Parallel.UPSegd as UPSegd
23 import qualified Data.Array.Parallel.Unlifted.Parallel.UPSSegd as UPSSegd
24 import qualified Data.Array.Parallel.Unlifted.Parallel.UPVSegd as UPVSegd
25 import qualified Data.Array.Parallel.Unlifted.Sequential.Vector as Seq
26 import qualified Data.Array.Parallel.Unlifted.Sequential.Combinators as Seq
27
28
29 import Data.Array.Parallel.Unlifted.Sequential.Vector (Unbox,Vector)
30 import Prelude (($!))
31
32 #include "DPH_Interface.h"
33
34 -- NOTE -----------------------------------------------------------------------
35 -- See DPH_Interface.h for documentation.
36 --
37 -- The definitions should appear in the same order as they are defined in DPH_Interface.h
38 --
39 -- Operations with at least O(n) time will print trace messages to console when
40 -- dph-base/D/A/P/Config.tracePrimEnabled is set to True.
41 --
42
43 -- Basics ---------------------------------------------------------------------
44 class (Unbox a, DT a) => Elt a
45 type Array = Vector
46
47
48 -- Constructors ---------------------------------------------------------------
49 empty = Seq.empty
50
51 (+:+) arr1 arr2
52 = tracePrim (TraceAppend (Seq.length arr1 + Seq.length arr2))
53 $! (Seq.++) arr1 arr2
54
55 replicate n val
56 = tracePrim (TraceReplicate n)
57 $! replicateUP n val
58
59 repeat n _ arr
60 = tracePrim (TraceRepeat n (Seq.length arr))
61 $! repeatUP n arr
62
63 indexed arr
64 = tracePrim (TraceIndexed (Seq.length arr))
65 $! indexedUP arr
66
67 enumFromTo from to
68 = let arr = enumFromToUP from to
69 in tracePrim (TraceEnumFromTo (Seq.length arr)) arr
70
71 enumFromThenTo from thn to
72 = let arr = enumFromThenToUP from thn to
73 in tracePrim (TraceEnumFromThenTo (Seq.length arr)) arr
74
75 enumFromStepLen from step len
76 = let arr = enumFromStepLenUP from step len
77 in tracePrim (TraceEnumFromStepLen (Seq.length arr)) arr
78
79 enumFromStepLenEach n starts steps lens
80 = let arr = enumFromStepLenEachUP n starts steps lens
81 in tracePrim (TraceEnumFromStepLenEach (Seq.length arr)) arr
82
83
84 -- Projections ----------------------------------------------------------------
85 length = Seq.length
86 (!:) = (Seq.!)
87
88 extract arr i n
89 = tracePrim (TraceExtract (Seq.length arr) i n)
90 $! Seq.extract arr i n
91
92 drop n arr
93 = tracePrim (TraceDrop n (Seq.length arr))
94 $! dropUP n arr
95
96 filter f src
97 = let dst = filterUP f src
98 in tracePrim (TraceFilter (Seq.length src) (Seq.length dst)) dst
99
100 permute arrSrc arrIxs
101 = tracePrim (TracePermute (Seq.length arrSrc))
102 $! Seq.permute arrSrc arrIxs
103
104 bpermute arrSrc arrIxs
105 = tracePrim (TraceBPermute (Seq.length arrSrc))
106 $! bpermuteUP arrSrc arrIxs
107
108
109 mbpermute f arrSrc streamIxs
110 = tracePrim (TraceMBPermute (Seq.length arrSrc))
111 $! Seq.mbpermute f arrSrc streamIxs
112
113 bpermuteDft len f arrIxs
114 = tracePrim (TraceBPermuteDft len)
115 $! Seq.bpermuteDft len f arrIxs
116
117
118 -- Update ---------------------------------------------------------------------
119 update arrSrc arrNew
120 = tracePrim (TraceUpdate (Seq.length arrSrc) (Seq.length arrNew))
121 $! updateUP arrSrc arrNew
122
123
124 -- Packing and Combining ------------------------------------------------------
125 pack arrSrc arrFlag
126 = tracePrim (TracePack (Seq.length arrSrc))
127 $! packUP arrSrc arrFlag
128
129
130 combine arrSel arr1 arr2
131 = tracePrim (TraceCombine (Seq.length arrSel))
132 $! combineUP arrSel arr1 arr2
133
134
135 combine2 arrTag sel arr1 arr2
136 = tracePrim (TraceCombine2 (Seq.length arrTag))
137 $! combine2UP arrTag sel arr1 arr2
138
139 interleave arr1 arr2
140 = tracePrim (TraceInterleave (Seq.length arr1 + Seq.length arr2))
141 $! interleaveUP arr1 arr2
142
143
144 -- Map and ZipWith ------------------------------------------------------------
145 map f arr
146 = tracePrim (TraceMap (Seq.length arr))
147 $! mapUP f arr
148
149 zipWith f arr1 arr2
150 = tracePrim (TraceZipWith (Seq.length arr1) (Seq.length arr2))
151 $! zipWithUP f arr1 arr2
152
153
154 -- Zipping and Unzipping ------------------------------------------------------
155 zip = Seq.zip
156 unzip = Seq.unzip
157 fsts = Seq.fsts
158 snds = Seq.snds
159
160 zip3 = Seq.zip3
161 unzip3 = Seq.unzip3
162
163
164 -- Folds ----------------------------------------------------------------------
165 fold f x arr
166 = tracePrim (TraceFold (Seq.length arr))
167 $! foldUP f x arr
168
169
170 fold1 f arr
171 = tracePrim (TraceFold1 (Seq.length arr))
172 $! Seq.fold1 f arr
173
174
175 and arr = tracePrim (TraceAnd (Seq.length arr))
176 $! andUP arr
177
178
179 sum arr = tracePrim (TraceSum (Seq.length arr))
180 $! sumUP arr
181
182
183 scan f x arr
184 = tracePrim (TraceScan (Seq.length arr))
185 $! scanUP f x arr
186
187
188 -- Segmented Constructors -----------------------------------------------------
189 replicate_s segd arr
190 = tracePrim (TraceReplicate_s (Seq.length arr))
191 $! UPSegd.replicateWithP segd arr
192
193
194 replicate_rs n arr
195 = tracePrim (TraceReplicate_rs n (Seq.length arr))
196 $! replicateRSUP n arr
197
198
199 append_s segd xd xs yd ys
200 = let arr = appendSUP segd xd xs yd ys
201 in tracePrim (TraceAppend_s (Seq.length arr)) arr
202
203
204 -- Segmented Projections ------------------------------------------------------
205 indices_s segd
206 = let arr = UPSegd.indicesP segd
207 in tracePrim (TraceIndices_s (Seq.length arr)) arr
208
209
210 -- Segmented Folds ------------------------------------------------------------
211 fold_s f x segd arr
212 = tracePrim (TraceFold_s (Seq.length arr))
213 $! UPSegd.foldWithP f x segd arr
214
215
216 fold1_s f segd arr
217 = tracePrim (TraceFold1_s (Seq.length arr))
218 $! UPSegd.fold1WithP f segd arr
219
220
221 fold_r f z segSize arr
222 = tracePrim (TraceFold_r (Seq.length arr))
223 $! Seq.foldlRU f z segSize arr
224
225
226 sum_r x arr
227 = tracePrim (TraceSum_r (Seq.length arr))
228 $! sumRUP x arr
229
230
231 -- Scattered Segmented Folds --------------------------------------------------
232 -- TODO: add tracing
233 fold_ss = UPSSegd.foldWithP
234 fold1_ss = UPSSegd.fold1WithP
235
236
237 -- Segment Descriptors --------------------------------------------------------
238 type Segd = UPSegd.UPSegd
239 mkSegd = UPSegd.mkUPSegd
240 validSegd = UPSegd.valid
241 emptySegd = UPSegd.empty
242 singletonSegd = UPSegd.singleton
243 lengthSegd = UPSegd.length
244 lengthsSegd = UPSegd.takeLengths
245 indicesSegd = UPSegd.takeIndices
246 elementsSegd = UPSegd.takeElements
247
248
249 -- Scattered Segment Descriptors ----------------------------------------------
250 type SSegd = UPSSegd.UPSSegd
251 mkSSegd = UPSSegd.mkUPSSegd
252 promoteSegdToSSegd = UPSSegd.fromUPSegd
253 validSSegd = UPSSegd.valid
254 emptySSegd = UPSSegd.empty
255 singletonSSegd = UPSSegd.singleton
256 isContiguousSSegd = UPSSegd.isContiguous
257 lengthSSegd = UPSSegd.length
258 lengthsSSegd = UPSSegd.takeLengths
259 indicesSSegd = UPSSegd.takeIndices
260 startsSSegd = UPSSegd.takeStarts
261 sourcesSSegd = UPSSegd.takeSources
262 getSegOfSSegd = UPSSegd.getSeg
263 appendSSegd = UPSSegd.appendWith
264
265
266 -- Virtual Segment Descriptors ------------------------------------------------
267 type VSegd = UPVSegd.UPVSegd
268 mkVSegd = UPVSegd.mkUPVSegd
269 validVSegd = UPVSegd.valid
270 promoteSegdToVSegd = UPVSegd.fromUPSegd
271 promoteSSegdToVSegd = UPVSegd.fromUPSSegd
272 emptyVSegd = UPVSegd.empty
273 singletonVSegd = UPVSegd.singleton
274 isManifestVSegd = UPVSegd.isManifest
275 isContiguousVSegd = UPVSegd.isContiguous
276 lengthOfVSegd = UPVSegd.length
277 takeVSegidsOfVSegd = UPVSegd.takeVSegids
278 takeSSegdOfVSegd = UPVSegd.takeUPSSegd
279 takeLengthsOfVSegd = UPVSegd.takeLengths
280 getSegOfVSegd = UPVSegd.getSeg
281 demoteToSSegdOfVSegd = UPVSegd.demoteToUPSSegd
282 demoteToSegdOfVSegd = UPVSegd.unsafeDemoteToUPSegd
283 updateVSegsOfVSegd = UPVSegd.updateVSegs
284 updateVSegsReachableOfVSegd = UPVSegd.updateVSegsReachable
285 appendVSegd = UPVSegd.appendWith
286 combine2VSegd = UPVSegd.combine2
287
288
289 -- Selectors ------------------------------------------------------------------
290 type Sel2 = UPSel2
291
292 mkSel2 tag is n0 n1 rep
293 = tracePrim (TraceMkSel2 (Seq.length is))
294 $! mkUPSel2 tag is n0 n1 rep
295
296 tagsSel2 sel
297 = let tags = tagsUPSel2 sel
298 in tracePrim (TraceTagsSel2 (Seq.length tags)) tags
299
300
301 indicesSel2 sel
302 = let arr = indicesUPSel2 sel
303 in tracePrim (TraceIndicesSel2 (Seq.length arr)) arr
304
305 elementsSel2_0 = elementsUPSel2_0
306 elementsSel2_1 = elementsUPSel2_1
307 repSel2 = repUPSel2
308
309
310 -- Selector Representations ---------------------------------------------------
311 type SelRep2 = UPSelRep2
312 mkSelRep2 = mkUPSelRep2
313
314 indicesSelRep2 = indicesUPSelRep2
315 elementsSelRep2_0 = elementsUPSelRep2_0
316 elementsSelRep2_1 = elementsUPSelRep2_1
317
318
319 -- Random arrays --------------------------------------------------------------
320 randoms = Seq.random
321 randomRs = Seq.randomR
322
323
324 -- IO -------------------------------------------------------------------------
325 class Seq.UIO a => IOElt a
326 hPut = Seq.hPut
327 hGet = Seq.hGet
328 toList = Seq.toList
329 fromList = Seq.fromList