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