dph-lifted-vseg: fix edge case in concatl when the last segment is empty
[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.Sequential.Vector (Unbox, Vector)
22 import Data.Array.Parallel.Unlifted.Parallel.UPSel
23 import qualified Data.Array.Parallel.Unlifted.Parallel.UPSegd as UPSegd
24 import qualified Data.Array.Parallel.Unlifted.Parallel.UPSSegd as UPSSegd
25 import qualified Data.Array.Parallel.Unlifted.Parallel.UPVSegd as UPVSegd
26 import qualified Data.Array.Parallel.Unlifted.Sequential.Vector as Seq
27 import qualified Data.Array.Parallel.Unlifted.Sequential.Combinators as Seq
28 import qualified Data.Array.Parallel.Unlifted.Sequential.Vector as V
29
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 takeVSegidsRedundantOfVSegd = UPVSegd.takeVSegidsRedundant
279 takeSSegdOfVSegd = UPVSegd.takeUPSSegd
280 takeSSegdRedundantOfVSegd = UPVSegd.takeUPSSegdRedundant
281 takeLengthsOfVSegd = UPVSegd.takeLengths
282 getSegOfVSegd = UPVSegd.getSeg
283 demoteToSSegdOfVSegd = UPVSegd.demoteToUPSSegd
284 demoteToSegdOfVSegd = UPVSegd.unsafeDemoteToUPSegd
285 updateVSegsOfVSegd = UPVSegd.updateVSegs
286 updateVSegsReachableOfVSegd = UPVSegd.updateVSegsReachable
287 appendVSegd = UPVSegd.appendWith
288 combine2VSegd = UPVSegd.combine2
289
290
291 -- Selectors ------------------------------------------------------------------
292 type Sel2 = UPSel2
293
294 mkSel2 tag is n0 n1 rep
295 = tracePrim (TraceMkSel2 (Seq.length is))
296 $! mkUPSel2 tag is n0 n1 rep
297
298 tagsSel2 sel
299 = let tags = tagsUPSel2 sel
300 in tracePrim (TraceTagsSel2 (Seq.length tags)) tags
301
302
303 indicesSel2 sel
304 = let arr = indicesUPSel2 sel
305 in tracePrim (TraceIndicesSel2 (Seq.length arr)) arr
306
307 elementsSel2_0 = elementsUPSel2_0
308 elementsSel2_1 = elementsUPSel2_1
309 repSel2 = repUPSel2
310
311
312 -- Selector Representations ---------------------------------------------------
313 type SelRep2 = UPSelRep2
314 mkSelRep2 = mkUPSelRep2
315
316 indicesSelRep2 = indicesUPSelRep2
317 elementsSelRep2_0 = elementsUPSelRep2_0
318 elementsSelRep2_1 = elementsUPSelRep2_1
319
320
321 -- Random arrays --------------------------------------------------------------
322 randoms = Seq.random
323 randomRs = Seq.randomR
324
325
326 -- IO -------------------------------------------------------------------------
327 class Seq.UIO a => IOElt a
328 hPut = Seq.hPut
329 hGet = Seq.hGet
330 toList = Seq.toList
331 fromList = Seq.fromList