e676f26cdc964f5e569e1b823b67e681ce3b942a
[packages/dph.git] / dph-common / Data / Array / Parallel / Lifted / Instances.hs
1 {-# LANGUAGE CPP #-}
2
3 #include "fusion-phases.h"
4
5 module Data.Array.Parallel.Lifted.Instances (
6 PArray(..),
7
8 dPA_Int, dPR_Int, upToPA_Int,
9
10 dPA_Word8, dPR_Word8,
11 dPA_Double, dPR_Double,
12
13 dPA_Bool, toPrimArrPA_Bool, truesPA#,
14 dPA_Unit, dPA_2, dPA_3, dPA_4, dPA_5,
15 dPA_PArray
16 ) where
17
18 import Data.Array.Parallel.Lifted.PArray
19 import Data.Array.Parallel.Lifted.Repr
20 import Data.Array.Parallel.Lifted.Unboxed
21
22 import GHC.Exts ( Int#, Int(..), (+#), (*#),
23 Double#, Double(..) )
24 import GHC.Word ( Word8(..) )
25
26 data instance PArray Int = PInt Int# PArray_Int#
27
28 type instance PRepr Int = Int
29
30 dPA_Int :: PA Int
31 {-# INLINE_PA dPA_Int #-}
32 dPA_Int = PA {
33 toPRepr = id
34 , fromPRepr = id
35 , toArrPRepr = id
36 , fromArrPRepr = id
37 , dictPRepr = dPR_Int
38 }
39
40 dPR_Int :: PR Int
41 {-# INLINE dPR_Int #-}
42 dPR_Int = PR {
43 lengthPR = lengthPR_Int
44 , emptyPR = emptyPR_Int
45 , replicatePR = replicatePR_Int
46 , replicatelPR = replicatelPR_Int
47 , repeatPR = repeatPR_Int
48 , repeatcPR = repeatcPR_Int
49 , indexPR = indexPR_Int
50 , bpermutePR = bpermutePR_Int
51 , extractPR = extractPR_Int
52 , appPR = appPR_Int
53 , applPR = applPR_Int
54 , packPR = packPR_Int
55 , combine2PR = combine2PR_Int
56 , fromListPR = fromListPR_Int
57 , nfPR = nfPR_Int
58 }
59
60 {-# INLINE lengthPR_Int #-}
61 lengthPR_Int (PInt n# _) = n#
62
63 {-# INLINE emptyPR_Int #-}
64 emptyPR_Int = PInt 0# emptyPA_Int#
65
66 {-# INLINE replicatePR_Int #-}
67 replicatePR_Int n# i = PInt n# (case i of I# i# -> replicatePA_Int# n# i#)
68
69 {-# INLINE replicatelPR_Int #-}
70 replicatelPR_Int segd (PInt _ is) = PInt (elementsSegdPA# segd)
71 (replicatelPA_Int# segd is)
72
73 {-# INLINE repeatPR_Int #-}
74 repeatPR_Int n# len# (PInt _ is) = PInt (n# *# len#) (repeatPA_Int# n# len# is)
75
76 {-# INLINE repeatcPR_Int #-}
77 repeatcPR_Int n# ns segd (PInt _ is)
78 = PInt n# (repeatcPA_Int# n# ns segd is)
79
80 {-# INLINE indexPR_Int #-}
81 indexPR_Int (PInt _ ns) i# = I# (indexPA_Int# ns i#)
82
83 {-# INLINE extractPR_Int #-}
84 extractPR_Int (PInt _ ns) i# n# = PInt n# (extractPA_Int# ns i# n#)
85
86 {-# INLINE bpermutePR_Int #-}
87 bpermutePR_Int n# (PInt _ ns) is = PInt n# (bpermutePA_Int# ns is)
88
89 {-# INLINE appPR_Int #-}
90 appPR_Int (PInt m# ms) (PInt n# ns) = PInt (m# +# n#) (appPA_Int# ms ns)
91
92 {-# INLINE applPR_Int #-}
93 applPR_Int is (PInt m# ms) js (PInt n# ns)
94 = PInt (m# +# n#) (applPA_Int# is ms js ns)
95
96 {-# INLINE packPR_Int #-}
97 packPR_Int (PInt _ ns) n# bs = PInt n# (packPA_Int# ns n# bs)
98
99 {-# INLINE combine2PR_Int #-}
100 combine2PR_Int n# sel is (PInt _ xs) (PInt _ ys)
101 = PInt n# (combine2PA_Int# n# sel is xs ys)
102
103 {-# INLINE fromListPR_Int #-}
104 fromListPR_Int n# xs = PInt n# (fromListPA_Int# n# xs)
105
106 {-# INLINE nfPR_Int #-}
107 nfPR_Int (PInt _ xs) = xs `seq` ()
108
109 upToPA_Int :: Int -> PArray Int
110 {-# INLINE_PA upToPA_Int #-}
111 upToPA_Int (I# n#) = PInt n# (upToPA_Int# n#)
112
113 data instance PArray Word8 = PWord8 Int# PArray_Word8#
114
115 type instance PRepr Word8 = Word8
116
117 dPA_Word8 :: PA Word8
118 {-# INLINE_PA dPA_Word8 #-}
119 dPA_Word8 = PA {
120 toPRepr = id
121 , fromPRepr = id
122 , toArrPRepr = id
123 , fromArrPRepr = id
124 , dictPRepr = dPR_Word8
125 }
126
127 dPR_Word8 :: PR Word8
128 {-# INLINE dPR_Word8 #-}
129 dPR_Word8 = PR {
130 lengthPR = lengthPR_Word8
131 , emptyPR = emptyPR_Word8
132 , replicatePR = replicatePR_Word8
133 , replicatelPR = replicatelPR_Word8
134 , repeatPR = repeatPR_Word8
135 , repeatcPR = repeatcPR_Word8
136 , indexPR = indexPR_Word8
137 , extractPR = extractPR_Word8
138 , bpermutePR = bpermutePR_Word8
139 , appPR = appPR_Word8
140 , applPR = applPR_Word8
141 , packPR = packPR_Word8
142 , combine2PR = combine2PR_Word8
143 , fromListPR = fromListPR_Word8
144 , nfPR = nfPR_Word8
145 }
146
147 {-# INLINE lengthPR_Word8 #-}
148 lengthPR_Word8 (PWord8 n# _) = n#
149
150 {-# INLINE emptyPR_Word8 #-}
151 emptyPR_Word8 = PWord8 0# emptyPA_Word8#
152
153 {-# INLINE replicatePR_Word8 #-}
154 replicatePR_Word8 n# d
155 = PWord8 n# (case d of W8# d# -> replicatePA_Word8# n# d#)
156
157 {-# INLINE replicatelPR_Word8 #-}
158 replicatelPR_Word8 segd (PWord8 _ ds)
159 = PWord8 (elementsSegdPA# segd) (replicatelPA_Word8# segd ds)
160
161 {-# INLINE repeatPR_Word8 #-}
162 repeatPR_Word8 n# len# (PWord8 _ is)
163 = PWord8 (n# *# len#) (repeatPA_Word8# n# len# is)
164
165 {-# INLINE repeatcPR_Word8 #-}
166 repeatcPR_Word8 n# ns segd (PWord8 _ is)
167 = PWord8 n# (repeatcPA_Word8# n# ns segd is)
168
169 {-# INLINE indexPR_Word8 #-}
170 indexPR_Word8 (PWord8 _ ds) i# = W8# (indexPA_Word8# ds i#)
171
172 {-# INLINE extractPR_Word8 #-}
173 extractPR_Word8 (PWord8 _ ns) i# n# = PWord8 n# (extractPA_Word8# ns i# n#)
174
175 {-# INLINE bpermutePR_Word8 #-}
176 bpermutePR_Word8 n# (PWord8 _ ds) is
177 = PWord8 n# (bpermutePA_Word8# ds is)
178
179 {-# INLINE appPR_Word8 #-}
180 appPR_Word8 (PWord8 m# ms) (PWord8 n# ns)
181 = PWord8 (m# +# n#) (appPA_Word8# ms ns)
182
183 {-# INLINE applPR_Word8 #-}
184 applPR_Word8 is (PWord8 m# ms) js (PWord8 n# ns)
185 = PWord8 (m# +# n#) (applPA_Word8# is ms js ns)
186
187 {-# INLINE packPR_Word8 #-}
188 packPR_Word8 (PWord8 _ ns) n# bs = PWord8 n# (packPA_Word8# ns n# bs)
189
190 {-# INLINE combine2PR_Word8 #-}
191 combine2PR_Word8 n# sel is (PWord8 _ xs) (PWord8 _ ys)
192 = PWord8 n# (combine2PA_Word8# n# sel is xs ys)
193
194 {-# INLINE fromListPR_Word8 #-}
195 fromListPR_Word8 n# xs = PWord8 n# (fromListPA_Word8# n# xs)
196
197 {-# INLINE nfPR_Word8 #-}
198 nfPR_Word8 (PWord8 _ xs) = xs `seq` ()
199
200 data instance PArray Double = PDouble Int# PArray_Double#
201
202 type instance PRepr Double = Double
203
204 dPA_Double :: PA Double
205 {-# INLINE_PA dPA_Double #-}
206 dPA_Double = PA {
207 toPRepr = id
208 , fromPRepr = id
209 , toArrPRepr = id
210 , fromArrPRepr = id
211 , dictPRepr = dPR_Double
212 }
213
214 dPR_Double :: PR Double
215 {-# INLINE dPR_Double #-}
216 dPR_Double = PR {
217 lengthPR = lengthPR_Double
218 , emptyPR = emptyPR_Double
219 , replicatePR = replicatePR_Double
220 , replicatelPR = replicatelPR_Double
221 , repeatPR = repeatPR_Double
222 , repeatcPR = repeatcPR_Double
223 , indexPR = indexPR_Double
224 , extractPR = extractPR_Double
225 , bpermutePR = bpermutePR_Double
226 , appPR = appPR_Double
227 , applPR = applPR_Double
228 , packPR = packPR_Double
229 , combine2PR = combine2PR_Double
230 , fromListPR = fromListPR_Double
231 , nfPR = nfPR_Double
232 }
233
234 {-# INLINE lengthPR_Double #-}
235 lengthPR_Double (PDouble n# _) = n#
236
237 {-# INLINE emptyPR_Double #-}
238 emptyPR_Double = PDouble 0# emptyPA_Double#
239
240 {-# INLINE replicatePR_Double #-}
241 replicatePR_Double n# d
242 = PDouble n# (case d of D# d# -> replicatePA_Double# n# d#)
243
244 {-# INLINE replicatelPR_Double #-}
245 replicatelPR_Double segd (PDouble _ ds)
246 = PDouble (elementsSegdPA# segd) (replicatelPA_Double# segd ds)
247
248 {-# INLINE repeatPR_Double #-}
249 repeatPR_Double n# len# (PDouble _ is)
250 = PDouble (n# *# len#) (repeatPA_Double# n# len# is)
251
252 {-# INLINE repeatcPR_Double #-}
253 repeatcPR_Double n# ns segd (PDouble _ is)
254 = PDouble n# (repeatcPA_Double# n# ns segd is)
255
256 {-# INLINE indexPR_Double #-}
257 indexPR_Double (PDouble _ ds) i# = D# (indexPA_Double# ds i#)
258
259 {-# INLINE extractPR_Double #-}
260 extractPR_Double (PDouble _ ns) i# n#
261 = PDouble n# (extractPA_Double# ns i# n#)
262
263 {-# INLINE bpermutePR_Double #-}
264 bpermutePR_Double n# (PDouble _ ds) is
265 = PDouble n# (bpermutePA_Double# ds is)
266
267 {-# INLINE appPR_Double #-}
268 appPR_Double (PDouble m# ms) (PDouble n# ns)
269 = PDouble (m# +# n#) (appPA_Double# ms ns)
270
271 {-# INLINE applPR_Double #-}
272 applPR_Double is (PDouble m# ms) js (PDouble n# ns)
273 = PDouble (m# +# n#) (applPA_Double# is ms js ns)
274
275 {-# INLINE packPR_Double #-}
276 packPR_Double (PDouble _ ns) n# bs = PDouble n# (packPA_Double# ns n# bs)
277
278 {-# INLINE combine2PR_Double #-}
279 combine2PR_Double n# sel is (PDouble _ xs) (PDouble _ ys)
280 = PDouble n# (combine2PA_Double# n# sel is xs ys)
281
282 {-# INLINE fromListPR_Double #-}
283 fromListPR_Double n# xs = PDouble n# (fromListPA_Double# n# xs)
284
285 {-# INLINE nfPR_Double #-}
286 nfPR_Double (PDouble _ xs) = xs `seq` ()
287
288 type instance PRepr Bool = Sum2 Void Void
289 data instance PArray Bool = PBool Int# PArray_Int# PArray_Int#
290 (PArray Void) (PArray Void)
291
292 dPA_Bool :: PA Bool
293 {-# INLINE_PA dPA_Bool #-}
294 dPA_Bool = PA {
295 toPRepr = toPRepr_Bool
296 , fromPRepr = fromPRepr_Bool
297 , toArrPRepr = toArrPRepr_Bool
298 , fromArrPRepr = fromArrPRepr_Bool
299 , dictPRepr = dPR_Sum2 dPR_Void dPR_Void
300 }
301
302 {-# INLINE toPRepr_Bool #-}
303 toPRepr_Bool False = Alt2_1 void
304 toPRepr_Bool True = Alt2_2 void
305
306 {-# INLINE fromPRepr_Bool #-}
307 fromPRepr_Bool (Alt2_1 _) = False
308 fromPRepr_Bool (Alt2_2 _) = True
309
310 {-# INLINE toArrPRepr_Bool #-}
311 toArrPRepr_Bool (PBool n# sel# is# fs ts) = PSum2 n# sel# is# fs ts
312
313 {-# INLINE fromArrPRepr_Bool #-}
314 fromArrPRepr_Bool (PSum2 n# sel# is# fs ts) = PBool n# sel# is# fs ts
315
316 toPrimArrPA_Bool :: PArray Bool -> PArray_Bool#
317 {-# INLINE toPrimArrPA_Bool #-}
318 toPrimArrPA_Bool (PBool _ ns# _ _ _) = toBoolPA# ns#
319
320 truesPA# :: PArray Bool -> Int#
321 {-# INLINE_PA truesPA# #-}
322 truesPA# (PBool _ _ _ fs ts) = lengthPA# dPA_Void ts
323
324 {-
325 data instance PArray Bool = PBool Int# PArray_Int# PArray_Int#
326
327 type instance PRepr Bool = Enumeration
328
329 dPA_Bool :: PA Bool
330 {-# INLINE_PA dPA_Bool #-}
331 dPA_Bool = PA {
332 toPRepr = toPRepr_Bool
333 , fromPRepr = fromPRepr_Bool
334 , toArrPRepr = toArrPRepr_Bool
335 , fromArrPRepr = fromArrPRepr_Bool
336 , dictPRepr = dPR_Enumeration
337 }
338
339 {-# INLINE toPRepr_Bool #-}
340 toPRepr_Bool False = Enumeration 0#
341 toPRepr_Bool True = Enumeration 1#
342
343 {-# INLINE fromPRepr_Bool #-}
344 fromPRepr_Bool (Enumeration 0#) = False
345 fromPRepr_Bool _ = True
346
347 {-# INLINE toArrPRepr_Bool #-}
348 toArrPRepr_Bool (PBool n# sel# is#) = PEnum n# sel# is#
349
350 {-# INLINE fromArrPRepr_Bool #-}
351 fromArrPRepr_Bool (PEnum n# sel# is#) = PBool n# sel# is#
352 -}
353
354 -- Tuples
355 --
356 -- We can use one of the following two representations
357 --
358 -- data instance PArray (a1,...,an) = PTup<n> !Int (STup<n> (PArray a1)
359 -- ...
360 -- (PArray an))
361 --
362 -- where STup<n> are strict n-ary tuples or
363 --
364 -- data instance PArray (a1,...,an) = PTup<n> !Int (PArray a1) ... (PArray an)
365 --
366 -- Consider the following two terms:
367 --
368 -- xs = replicateP n (_|_, _|_)
369 -- ys = replicateP n (_|_ :: (t,u))
370 --
371 -- These have to be represented differently; in particular, we have
372 --
373 -- xs !: 0 = (_|_,_|_)
374 -- ys !: 0 = _|_
375 --
376 -- but
377 --
378 -- lengthP xs = lengthP ys = n
379 --
380 -- With he first representation, we have
381 --
382 -- xs = PTup2 n (STup2 (replicateP n _|_) (replicateP n _|_))
383 -- ys = PTup2 n _|_
384 --
385 -- With
386 --
387 -- PTup2 n (STup2 xs ys) !: i = (xs !: i, ys !: i)
388 -- lengthP (PTup2 n _) = n
389 --
390 -- this gives use the desired result. With the second representation we might
391 -- use:
392 --
393 -- replicateP n p = PArray n (p `seq` replicateP n x)
394 -- (p `seq` replicateP n y)
395 -- where
396 -- (x,y) = p
397 --
398 -- which gives us
399 --
400 -- xs = PTup2 n (replicateP n _|_) (replicateP n _|_)
401 -- ys = PTup2 n _|_ _|_
402 --
403 -- We'd then have to use
404 --
405 -- PTup2 n xs ys !: i = xs `seq` ys `seq` (xs !: i, ys !: i)
406 -- lengthP (PTup2 n _) = n
407 --
408 -- Not sure which is better (the first seems slightly cleaner) but we'll go
409 -- with the second repr for now as it makes closure environments slightly
410 -- simpler to construct and to take apart.
411
412 {-
413 data STup2 a b = STup2 !a !b
414 data STup3 a b c = STup3 !a !b !c
415 data STup4 a b c d = STup4 !a !b !c !d
416 data STup5 a b c d e = STup5 !a !b !c !d !e
417 -}
418
419 type instance PRepr () = ()
420
421 dPA_Unit :: PA ()
422 {-# INLINE_PA dPA_Unit #-}
423 dPA_Unit = PA {
424 toPRepr = id
425 , fromPRepr = id
426 , toArrPRepr = id
427 , fromArrPRepr = id
428 , dictPRepr = dPR_Unit
429 }
430
431 type instance PRepr (a,b) = (a,b)
432
433 dPA_2 :: PA a -> PA b -> PA (a,b)
434 {-# INLINE_PA dPA_2 #-}
435 dPA_2 pa pb = PA {
436 toPRepr = id
437 , fromPRepr = id
438 , toArrPRepr = id
439 , fromArrPRepr = id
440 , dictPRepr = dPR_2 (mkPR pa) (mkPR pb)
441 }
442
443 type instance PRepr (a,b,c) = (a,b,c)
444
445 dPA_3 :: PA a -> PA b -> PA c -> PA (a,b,c)
446 {-# INLINE_PA dPA_3 #-}
447 dPA_3 pa pb pc
448 = PA {
449 toPRepr = id
450 , fromPRepr = id
451 , toArrPRepr = id
452 , fromArrPRepr = id
453 , dictPRepr = dPR_3 (mkPR pa) (mkPR pb) (mkPR pc)
454 }
455
456 type instance PRepr (a,b,c,d) = (a,b,c,d)
457
458 dPA_4 :: PA a -> PA b -> PA c -> PA d -> PA (a,b,c,d)
459 {-# INLINE_PA dPA_4 #-}
460 dPA_4 pa pb pc pd
461 = PA {
462 toPRepr = id
463 , fromPRepr = id
464 , toArrPRepr = id
465 , fromArrPRepr = id
466 , dictPRepr = dPR_4 (mkPR pa) (mkPR pb) (mkPR pc) (mkPR pd)
467 }
468
469 type instance PRepr (a,b,c,d,e) = (a,b,c,d,e)
470
471 dPA_5 :: PA a -> PA b -> PA c -> PA d -> PA e -> PA (a,b,c,d,e)
472 {-# INLINE_PA dPA_5 #-}
473 dPA_5 pa pb pc pd pe
474 = PA {
475 toPRepr = id
476 , fromPRepr = id
477 , toArrPRepr = id
478 , fromArrPRepr = id
479 , dictPRepr = dPR_5 (mkPR pa) (mkPR pb) (mkPR pc) (mkPR pd) (mkPR pe)
480 }
481
482 type instance PRepr (PArray a) = PArray (PRepr a)
483
484 dPA_PArray :: PA a -> PA (PArray a)
485 {-# INLINE_PA dPA_PArray #-}
486 dPA_PArray pa
487 = PA {
488 toPRepr = toArrPRepr pa
489 , fromPRepr = fromArrPRepr pa
490 , toArrPRepr = toNestedPRepr pa
491 , fromArrPRepr = fromNestedPRepr pa
492 , dictPRepr = dPR_PArray (dictPRepr pa)
493 }
494
495 {-# INLINE toNestedPRepr #-}
496 toNestedPRepr pa (PNested n# lens is xs)
497 = PNested n# lens is (toArrPRepr pa xs)
498
499 {-# INLINE fromNestedPRepr #-}
500 fromNestedPRepr pa (PNested n# lens is xs)
501 = PNested n# lens is (fromArrPRepr pa xs)
502