87b40aee8f48dbbd4585237dcf4d1fef61775e98
[packages/dph.git] / dph-common / Data / Array / Parallel / Lifted / Repr.hs
1 {-# LANGUAGE EmptyDataDecls #-}
2 {-# LANGUAGE CPP #-}
3
4 #include "fusion-phases.h"
5
6 module Data.Array.Parallel.Lifted.Repr (
7 PArray(..),
8 Void, void,
9 Wrap(..),
10 Enumeration(..),
11 Sum2(..), Sum3(..),
12
13 dPA_Void,
14 dPR_Void, dPR_Unit, dPR_Wrap,
15 dPR_Enumeration,
16 dPR_2, dPR_3, dPR_4, dPR_5, zipPA#, unzipPA#, zip3PA#,
17 dPR_Sum2, dPR_Sum3,
18
19 dPR_PArray, nested_lengthPA, segdOfPA#, concatPA#,
20 ) where
21
22 import Data.Array.Parallel.Lifted.PArray
23 import Data.Array.Parallel.Lifted.Unboxed
24
25 import Data.Array.Parallel.Base ((:*:)(..), fromBool)
26
27 import qualified Data.List as L
28 import GHC.Exts (Int#, Int(..), (+#), (-#), (*#))
29 import Debug.Trace
30
31
32
33 data Void
34
35 traceFn = flip const -- trace
36 traceArgs = flip const -- trace
37
38 void :: Void
39 void = error "Data.Array.Parallel.void"
40
41 data instance PArray Void = PVoid Int#
42
43 dPR_Void :: PR Void
44 {-# INLINE dPR_Void #-}
45 dPR_Void = PR {
46 lengthPR = lengthPR_Void
47 , emptyPR = emptyPR_Void
48 , replicatePR = replicatePR_Void
49 , replicatelPR = replicatelPR_Void
50 , repeatPR = repeatPR_Void
51 , repeatcPR = repeatcPR_Void
52 , indexPR = indexPR_Void
53 , extractPR = extractPR_Void
54 , bpermutePR = bpermutePR_Void
55 , appPR = appPR_Void
56 , applPR = applPR_Void
57 , packPR = packPR_Void
58 , combine2PR = combine2PR_Void
59 , fromListPR = fromListPR_Void
60 , nfPR = nfPR_Void
61 }
62
63 {-# INLINE lengthPR_Void #-}
64 lengthPR_Void (PVoid n#) =
65 n#
66
67 {-# INLINE emptyPR_Void #-}
68 emptyPR_Void = traceFn "emptyPR_Void" $
69 PVoid 0#
70
71 {-# INLINE replicatePR_Void #-}
72 replicatePR_Void n# _ = traceFn "replicatePR_Void" $
73 PVoid n#
74
75 {-# INLINE replicatelPR_Void #-}
76 replicatelPR_Void segd _ = traceFn "replicatelPR_Void" $
77 PVoid (elementsSegdPA# segd)
78
79 {-# INLINE repeatPR_Void #-}
80 repeatPR_Void n# len# (PVoid _) = traceFn "repeatPR_Void" $
81 PVoid (n# *# len#)
82
83 {-# INLINE repeatcPR_Void #-}
84 repeatcPR_Void n# _ _ (PVoid _) = traceFn "repeatcPR_Void" $
85 PVoid n#
86
87 indexPR_Void :: PArray Void -> Int# -> Void
88 {-# INLINE indexPR_Void #-}
89 indexPR_Void (PVoid n#) i# = traceFn "indexPR_Void" $
90 void
91
92 extractPR_Void :: PArray Void -> Int# -> Int# -> PArray Void
93 {-# INLINE extractPR_Void #-}
94 extractPR_Void (PVoid _) i# n# = traceFn "extractPR_Void" $
95 PVoid n#
96
97 {-# INLINE bpermutePR_Void #-}
98 bpermutePR_Void n# (PVoid _) _ = traceFn "bpermutePR_Void" $
99 PVoid n#
100
101 {-# INLINE appPR_Void #-}
102 appPR_Void (PVoid m#) (PVoid n#) = traceFn "appPR_Void" $
103 PVoid (m# +# n#)
104
105 {-# INLINE applPR_Void #-}
106 applPR_Void _ (PVoid m#) _ (PVoid n#) = traceFn "applPR_Void" $
107 PVoid (m# +# n#)
108
109 {-# INLINE packPR_Void #-}
110 packPR_Void (PVoid _) n# _ = traceFn "packPR_Void" $
111 PVoid n#
112
113 {-# INLINE combine2PR_Void #-}
114 combine2PR_Void n# _ _ (PVoid _) (PVoid _) = traceFn "combine2PR_Void" $
115 PVoid n#
116
117 {-# INLINE fromListPR_Void #-}
118 fromListPR_Void n# _ = PVoid n#
119
120 {-# INLINE nfPR_Void #-}
121 nfPR_Void (PVoid _) = ()
122
123 type instance PRepr Void = Void
124
125 dPA_Void :: PA Void
126 {-# INLINE_PA dPA_Void #-}
127 dPA_Void = PA {
128 toPRepr = id
129 , fromPRepr = id
130 , toArrPRepr = id
131 , fromArrPRepr = id
132 , dictPRepr = dPR_Void
133 }
134
135 data instance PArray () = PUnit Int# ()
136
137 dPR_Unit :: PR ()
138 {-# INLINE dPR_Unit #-}
139 dPR_Unit = PR {
140 lengthPR = lengthPR_Unit
141 , emptyPR = emptyPR_Unit
142 , replicatePR = replicatePR_Unit
143 , replicatelPR = replicatelPR_Unit
144 , repeatPR = repeatPR_Unit
145 , repeatcPR = repeatcPR_Unit
146 , indexPR = indexPR_Unit
147 , extractPR = extractPR_Unit
148 , bpermutePR = bpermutePR_Unit
149 , appPR = appPR_Unit
150 , applPR = applPR_Unit
151 , packPR = packPR_Unit
152 , combine2PR = combine2PR_Unit
153 , fromListPR = fromListPR_Unit
154 , nfPR = nfPR_Unit
155 }
156
157
158 {-# INLINE lengthPR_Unit #-}
159 lengthPR_Unit (PUnit n# _) =
160 n#
161
162 {-# INLINE emptyPR_Unit #-}
163 emptyPR_Unit = traceFn "emptyPR_Unit" $
164 PUnit 0# ()
165
166 {-# INLINE replicatePR_Unit #-}
167 replicatePR_Unit n# u =
168 traceFn "replicatePR_Unit" $
169 traceArgs ("replicatePR_Unit len = " ++ show (I# n#)) $
170 PUnit n# u
171
172 {-# INLINE replicatelPR_Unit #-}
173 replicatelPR_Unit segd (PUnit _ u) =
174 traceFn "replicatelPR_Unit"
175 traceArgs ("replicatelPR_Unit args len = " ++ (show (I# (elementsSegdPA# segd))))$
176 PUnit (elementsSegdPA# segd) u
177
178 {-# INLINE repeatPR_Unit #-}
179 repeatPR_Unit n# len# (PUnit _ u) = traceFn "repeatPR_Unit" $
180 PUnit (n# *# len#) u
181
182 {-# INLINE repeatcPR_Unit #-}
183 repeatcPR_Unit n# _ _ (PUnit _ u) = traceFn "repeatcPR_Unit" $
184 PUnit n# u
185
186 indexPR_Unit :: PArray () -> Int# -> ()
187 {-# INLINE indexPR_Unit #-}
188 indexPR_Unit (PUnit n# u) i# = traceFn "indexPR_Unit" $
189 u
190
191 extractPR_Unit :: PArray () -> Int# -> Int# -> PArray ()
192 {-# INLINE extractPR_Unit #-}
193 extractPR_Unit (PUnit _ u) _ n# = traceFn "extractPR_Unit" $
194 PUnit n# u
195
196 {-# INLINE bpermutePR_Unit #-}
197 bpermutePR_Unit n# (PUnit _ u) _ = traceFn "bpermutePR_Unit" $
198 PUnit n# u
199
200 {-# INLINE appPR_Unit #-}
201 appPR_Unit (PUnit m# u) (PUnit n# v) = traceFn "appPR_Unit" $
202 PUnit (m# +# n#) (u `seq` v)
203
204 {-# INLINE applPR_Unit #-}
205 applPR_Unit _ (PUnit m# u) _ (PUnit n# v) = traceFn "applPR_Unit" $
206 PUnit (m# +# n#) (u `seq` v)
207
208 {-# INLINE packPR_Unit #-}
209 packPR_Unit (PUnit _ u) n# _ = traceFn "packPR_Unit" $
210 PUnit n# u
211
212 {-# INLINE combine2PR_Unit #-}
213 combine2PR_Unit n# _ _ (PUnit _ u1) (PUnit _ u2) = traceFn "combine2PR_Unit" $
214 PUnit n# (u1 `seq` u2)
215
216 {-# INLINE fromListPR_Unit #-}
217 fromListPR_Unit n# xs = PUnit n# (foldr seq () xs)
218
219 {-# INLINE nfPR_Unit #-}
220 nfPR_Unit (PUnit _ u) = u
221
222 data Wrap a = Wrap a
223
224 data instance PArray (Wrap a) = PWrap Int# (PArray a)
225
226 dPR_Wrap :: PR a -> PR (Wrap a)
227 {-# INLINE dPR_Wrap #-}
228 dPR_Wrap pr = PR {
229 lengthPR = lengthPR_Wrap
230 , emptyPR = emptyPR_Wrap pr
231 , replicatePR = replicatePR_Wrap pr
232 , replicatelPR = replicatelPR_Wrap pr
233 , repeatPR = repeatPR_Wrap pr
234 , repeatcPR = repeatcPR_Wrap pr
235 , indexPR = indexPR_Wrap pr
236 , extractPR = extractPR_Wrap pr
237 , bpermutePR = bpermutePR_Wrap pr
238 , appPR = appPR_Wrap pr
239 , applPR = applPR_Wrap pr
240 , packPR = packPR_Wrap pr
241 , combine2PR = combine2PR_Wrap pr
242 }
243
244 {-# INLINE lengthPR_Wrap #-}
245 lengthPR_Wrap (PWrap n# _) =
246 n#
247
248 {-# INLINE emptyPR_Wrap #-}
249 emptyPR_Wrap pr = traceFn "emptyPR_Wrap" $
250 PWrap 0# (emptyPR pr)
251
252 {-# INLINE replicatePR_Wrap #-}
253 replicatePR_Wrap pr n# ~(Wrap x) = traceFn "replicatePR_Wrap" $
254 PWrap n# (replicatePR pr n# x)
255
256 {-# INLINE replicatelPR_Wrap #-}
257 replicatelPR_Wrap pr segd (PWrap _ xs) = traceFn "replicatelPR_Wrap" $
258 PWrap (elementsSegdPA# segd) (replicatelPR pr segd xs)
259
260 {-# INLINE repeatPR_Wrap #-}
261 repeatPR_Wrap pr n# len# (PWrap _ xs) = traceFn "repeatPR_Wrap" $
262 PWrap (n# *# len#) (repeatPR pr n# len# xs)
263
264 {-# INLINE repeatcPR_Wrap #-}
265 repeatcPR_Wrap pr n# is segd (PWrap _ xs) = traceFn "repeatcPR_Wrap" $
266 PWrap n# (repeatcPR pr n# is segd xs)
267
268 {-# INLINE indexPR_Wrap #-}
269 indexPR_Wrap pr (PWrap n# xs) i# = traceFn "indexPR_Wrap" $
270 Wrap (indexPR pr xs i#)
271
272 {-# INLINE extractPR_Wrap #-}
273 extractPR_Wrap pr (PWrap _ xs) i# n# = traceFn "extractPR_Wrap" $
274 PWrap n# (extractPR pr xs i# n#)
275
276 {-# INLINE bpermutePR_Wrap #-}
277 bpermutePR_Wrap pr n# (PWrap _ xs) is = traceFn "bpermutePR_Wrap" $
278 PWrap n# (bpermutePR pr n# xs is)
279
280 {-# INLINE appPR_Wrap #-}
281 appPR_Wrap pr (PWrap m# xs) (PWrap n# ys) = traceFn "appPR_Wrap" $
282 PWrap (m# +# n#) (appPR pr xs ys)
283
284 {-# INLINE applPR_Wrap #-}
285 applPR_Wrap pr is (PWrap m# xs) js (PWrap n# ys) = traceFn "applPR_Wrap" $
286 PWrap (m# +# n#) (applPR pr is xs js ys)
287
288 {-# INLINE packPR_Wrap #-}
289 packPR_Wrap pr (PWrap _ xs) n# sel# = traceFn "packPR_Wrap" $
290 PWrap n# (packPR pr xs n# sel#)
291
292 combine2PR_Wrap:: PR a -> Int# -> PArray_Int# -> PArray_Int#
293 -> PArray (Wrap a) -> PArray (Wrap a) -> PArray (Wrap a)
294 combine2PR_Wrap _ _ _ _ _ = traceFn "combine2PR_Wrap" $
295 error "combine2PR_Wrap nyi"
296
297 data Enumeration = Enumeration Int#
298
299 data instance PArray Enumeration = PEnum Int# PArray_Int# PArray_Int#
300
301 dPR_Enumeration :: PR Enumeration
302 {-# INLINE dPR_Enumeration #-}
303 dPR_Enumeration = PR {
304 lengthPR = lengthPR_Enumeration
305 , emptyPR = emptyPR_Enumeration
306 , replicatePR = replicatePR_Enumeration
307 }
308
309 {-# INLINE lengthPR_Enumeration #-}
310 lengthPR_Enumeration (PEnum n# _ _) = n#
311
312 {-# INLINE emptyPR_Enumeration #-}
313 emptyPR_Enumeration = traceFn "emptyPR_Enumeration" $
314 PEnum 0# emptyPA_Int# emptyPA_Int#
315
316 {-# INLINE replicatePR_Enumeration #-}
317 replicatePR_Enumeration n# enum
318 = traceFn "replicatePR_Enumeration" $
319 PEnum n# (replicatePA_Int# n# (case enum of { Enumeration i# -> i# }))
320 (upToPA_Int# n#)
321
322 data instance PArray (a,b)
323 = P_2 Int# (PArray a)
324 (PArray b)
325
326 data instance PArray (a,b,c)
327 = P_3 Int# (PArray a)
328 (PArray b)
329 (PArray c)
330
331 data instance PArray (a,b,c,d)
332 = P_4 Int# (PArray a)
333 (PArray b)
334 (PArray c)
335 (PArray d)
336
337 data instance PArray (a,b,c,d,e)
338 = P_5 Int# (PArray a)
339 (PArray b)
340 (PArray c)
341 (PArray d)
342 (PArray e)
343
344 dPR_2 :: PR a -> PR b -> PR (a,b)
345 {-# INLINE dPR_2 #-}
346 dPR_2 pra prb
347 = PR {
348 lengthPR = lengthPR_2
349 , emptyPR = emptyPR_2 pra prb
350 , replicatePR = replicatePR_2 pra prb
351 , replicatelPR = replicatelPR_2 pra prb
352 , repeatPR = repeatPR_2 pra prb
353 , repeatcPR = repeatcPR_2 pra prb
354 , indexPR = indexPR_2 pra prb
355 , extractPR = extractPR_2 pra prb
356 , bpermutePR = bpermutePR_2 pra prb
357 , appPR = appPR_2 pra prb
358 , applPR = applPR_2 pra prb
359 , packPR = packPR_2 pra prb
360 , combine2PR = combine2PR_2 pra prb
361 , fromListPR = fromListPR_2 pra prb
362 , nfPR = nfPR_2 pra prb
363 }
364
365 {-# INLINE lengthPR_2 #-}
366 lengthPR_2 (P_2 n# _ _) = n#
367
368 {-# INLINE emptyPR_2 #-}
369 emptyPR_2 pra prb = traceFn "emptyPR_2" $
370 P_2 0# (emptyPR pra) (emptyPR prb)
371
372 {-# INLINE replicatePR_2 #-}
373 replicatePR_2 pra prb n# ~(a,b) =
374 traceFn "replicatePR_2" $
375 traceArgs ("replicatePR_2 args len = " ++ (show (I# n#))) $
376 P_2 n# (replicatePR pra n# a)
377 (replicatePR prb n# b)
378
379 {-# INLINE replicatelPR_2 #-}
380 replicatelPR_2 pra prb segd (P_2 _ as bs)
381 = traceFn "replicatelPR_2" $
382 P_2 (elementsSegdPA# segd) (replicatelPR pra segd as)
383 (replicatelPR prb segd bs)
384
385 {-# INLINE repeatPR_2 #-}
386 repeatPR_2 pra prb n# len# (P_2 _ as bs)
387 = traceFn "repeatPR_2" $
388 P_2 (n# *# len#) (repeatPR pra n# len# as)
389 (repeatPR prb n# len# bs)
390
391 {-# INLINE repeatcPR_2 #-}
392 repeatcPR_2 pra prb n# ns segd (P_2 _ as bs)
393 = traceFn "repeatcPR_2" $
394 P_2 n# (repeatcPR pra n# ns segd as)
395 (repeatcPR prb n# ns segd bs)
396
397 {-# INLINE indexPR_2 #-}
398 indexPR_2 pra prb (P_2 _ as bs) i# = traceFn "indexPR_2" $
399 (indexPR pra as i#, indexPR prb bs i#)
400
401 {-# INLINE extractPR_2 #-}
402 extractPR_2 pra prb (P_2 _ as bs) i# n# = traceFn "extractPR_2" $
403 P_2 n# (extractPR pra as i# n#)
404 (extractPR prb bs i# n#)
405
406 {-# INLINE bpermutePR_2 #-}
407 bpermutePR_2 pra prb n# (P_2 _ as bs) is
408 = traceFn "bpermutePR_2" $
409 P_2 n# (bpermutePR pra n# as is) (bpermutePR prb n# bs is)
410
411 {-# INLINE appPR_2 #-}
412 appPR_2 pra prb (P_2 m# as1 bs1) (P_2 n# as2 bs2)
413 = P_2 (m# +# n#) (appPR pra as1 as2) (appPR prb bs1 bs2)
414
415 {-# INLINE applPR_2 #-}
416 applPR_2 pra prb is (P_2 m# as1 bs1) js (P_2 n# as2 bs2)
417 = traceFn "applPR_2" $
418 P_2 (m# +# n#) (applPR pra is as1 js as2)
419 (applPR prb is bs1 js bs2)
420
421 {-# INLINE packPR_2 #-}
422 packPR_2 pra prb (P_2 _ as bs) n# sel# = traceFn "packPR_2" $
423 P_2 n# (packPR pra as n# sel#)
424 (packPR prb bs n# sel#)
425
426 {-# INLINE combine2PR_2 #-}
427 combine2PR_2 pra prb n# sel# is# (P_2 _ as1 bs1) (P_2 _ as2 bs2)
428 = traceFn "combine2PR_2" $
429 P_2 n# (combine2PR pra n# sel# is# as1 as2)
430 (combine2PR prb n# sel# is# bs1 bs2)
431
432 {-# INLINE fromListPR_2 #-}
433 fromListPR_2 pra prb n# xs
434 = P_2 n# (fromListPR pra n# as)
435 (fromListPR prb n# bs)
436 where
437 (as,bs) = unzip xs
438
439 {-# INLINE nfPR_2 #-}
440 nfPR_2 pra prb (P_2 _ as bs)
441 = nfPR pra as `seq` nfPR prb bs
442
443 zipPA# :: PA a -> PA b -> PArray a -> PArray b -> PArray (a,b)
444 {-# INLINE_PA zipPA# #-}
445 zipPA# pa pb xs ys =
446 traceFn "zipPA" $
447 traceArgs ("zipPA args len1:" ++ show (I# (lengthPA# pa xs)) ++
448 "\nlen2:" ++ show (I# (lengthPA# pb ys))
449 ) $
450 P_2 (lengthPA# pa xs) xs ys
451
452 unzipPA# :: PA a -> PA b -> PArray (a,b) -> (PArray a, PArray b)
453 {-# INLINE_PA unzipPA# #-}
454 unzipPA# pa pb (P_2 n xs ys) = traceFn "unzipPA" $
455 (xs, ys)
456
457 dPR_3 :: PR a -> PR b -> PR c -> PR (a,b,c)
458 {-# INLINE dPR_3 #-}
459 dPR_3 pra prb prc
460 = PR {
461 lengthPR = lengthPR_3
462 , emptyPR = emptyPR_3 pra prb prc
463 , replicatePR = replicatePR_3 pra prb prc
464 , replicatelPR = replicatelPR_3 pra prb prc
465 , repeatPR = repeatPR_3 pra prb prc
466 , repeatcPR = repeatcPR_3 pra prb prc
467 , indexPR = indexPR_3 pra prb prc
468 , extractPR = extractPR_3 pra prb prc
469 , bpermutePR = bpermutePR_3 pra prb prc
470 , appPR = appPR_3 pra prb prc
471 , applPR = applPR_3 pra prb prc
472 , packPR = packPR_3 pra prb prc
473 , combine2PR = combine2PR_3 pra prb prc
474 , fromListPR = fromListPR_3 pra prb prc
475 , nfPR = nfPR_3 pra prb prc
476 }
477
478 {-# INLINE lengthPR_3 #-}
479 lengthPR_3 (P_3 n# _ _ _) = n#
480
481 {-# INLINE emptyPR_3 #-}
482 emptyPR_3 pra prb prc = traceFn "emptyPR_3" $
483 P_3 0# (emptyPR pra) (emptyPR prb) (emptyPR prc)
484
485 {-# INLINE replicatePR_3 #-}
486 replicatePR_3 pra prb prc n# ~(a,b,c)
487 = traceFn "replicatePR_3" $
488 P_3 n# (replicatePR pra n# a)
489 (replicatePR prb n# b)
490 (replicatePR prc n# c)
491
492 {-# INLINE replicatelPR_3 #-}
493 replicatelPR_3 pra prb prc segd (P_3 _ as bs cs)
494 = traceFn "replicatelPR_3" $
495 P_3 (elementsSegdPA# segd) (replicatelPR pra segd as)
496 (replicatelPR prb segd bs)
497 (replicatelPR prc segd cs)
498
499 {-# INLINE repeatPR_3 #-}
500 repeatPR_3 pra prb prc n# len# (P_3 _ as bs cs)
501 = traceFn "repeatPR_3" $
502 P_3 (n# *# len#) (repeatPR pra n# len# as)
503 (repeatPR prb n# len# bs)
504 (repeatPR prc n# len# cs)
505
506 {-# INLINE repeatcPR_3 #-}
507 repeatcPR_3 pra prb prc n# ns segd (P_3 _ as bs cs)
508 = traceFn "repeatcPR_3" $
509 P_3 n# (repeatcPR pra n# ns segd as)
510 (repeatcPR prb n# ns segd bs)
511 (repeatcPR prc n# ns segd cs)
512
513 {-# INLINE indexPR_3 #-}
514 indexPR_3 pra prb prc (P_3 n# as bs cs) i#
515 = traceFn "indexPR_3" $
516 (indexPR pra as i#, indexPR prb bs i#, indexPR prc cs i#)
517
518 {-# INLINE extractPR_3 #-}
519 extractPR_3 pra prb prc (P_3 _ as bs cs) i# n# = traceFn "extractPR_3" $
520 P_3 n# (extractPR pra as i# n#)
521 (extractPR prb bs i# n#)
522 (extractPR prc cs i# n#)
523
524 {-# INLINE bpermutePR_3 #-}
525 bpermutePR_3 pra prb prc n# (P_3 _ as bs cs) is
526 = traceFn "bpermutePR_3" $
527 P_3 n# (bpermutePR pra n# as is)
528 (bpermutePR prb n# bs is)
529 (bpermutePR prc n# cs is)
530
531 {-# INLINE appPR_3 #-}
532 appPR_3 pra prb prc (P_3 m# as1 bs1 cs1) (P_3 n# as2 bs2 cs2)
533 = traceFn "appPR_3" $
534 P_3 (m# +# n#) (appPR pra as1 as2) (appPR prb bs1 bs2) (appPR prc cs1 cs2)
535
536 {-# INLINE applPR_3 #-}
537 applPR_3 pra prb prc is (P_3 m# as1 bs1 cs1) js (P_3 n# as2 bs2 cs2)
538 = traceFn "applPR_3" $
539 P_3 (m# +# n#) (applPR pra is as1 js as2)
540 (applPR prb is bs1 js bs2)
541 (applPR prc is cs1 js cs2)
542
543 {-# INLINE packPR_3 #-}
544 packPR_3 pra prb prc (P_3 _ as bs cs) n# sel#
545 = traceFn "packPR_3" $
546 P_3 n# (packPR pra as n# sel#)
547 (packPR prb bs n# sel#)
548 (packPR prc cs n# sel#)
549
550 {-# INLINE combine2PR_3 #-}
551 combine2PR_3 pra prb prc n# sel# is# (P_3 _ as1 bs1 cs1)
552 (P_3 _ as2 bs2 cs2)
553 = traceFn "combine2PR_3" $
554 P_3 n# (combine2PR pra n# sel# is# as1 as2)
555 (combine2PR prb n# sel# is# bs1 bs2)
556 (combine2PR prc n# sel# is# cs1 cs2)
557
558 {-# INLINE fromListPR_3 #-}
559 fromListPR_3 pra prb prc n# xs
560 = P_3 n# (fromListPR pra n# as)
561 (fromListPR prb n# bs)
562 (fromListPR prc n# cs)
563 where
564 (as,bs,cs) = unzip3 xs
565
566 {-# INLINE nfPR_3 #-}
567 nfPR_3 pra prb prc (P_3 _ as bs cs)
568 = nfPR pra as
569 `seq` nfPR prb bs
570 `seq` nfPR prc cs
571
572 zip3PA# :: PA a -> PA b -> PA c
573 -> PArray a -> PArray b -> PArray c -> PArray (a,b,c)
574 {-# INLINE_PA zip3PA# #-}
575 zip3PA# pa pb pc xs ys zs = traceFn "zip3PA" $
576 P_3 (lengthPA# pa xs) xs ys zs
577
578 dPR_4 :: PR a -> PR b -> PR c -> PR d -> PR (a,b,c,d)
579 {-# INLINE dPR_4 #-}
580 dPR_4 pra prb prc prd
581 = PR {
582 lengthPR = lengthPR_4
583 , emptyPR = emptyPR_4 pra prb prc prd
584 , replicatePR = replicatePR_4 pra prb prc prd
585 , replicatelPR = replicatelPR_4 pra prb prc prd
586 , repeatPR = repeatPR_4 pra prb prc prd
587 , repeatcPR = repeatcPR_4 pra prb prc prd
588 , indexPR = indexPR_4 pra prb prc prd
589 , extractPR = extractPR_4 pra prb prc prd
590 , bpermutePR = bpermutePR_4 pra prb prc prd
591 , appPR = appPR_4 pra prb prc prd
592 , applPR = applPR_4 pra prb prc prd
593 , packPR = packPR_4 pra prb prc prd
594 , combine2PR = combine2PR_4 pra prb prc prd
595 , fromListPR = fromListPR_4 pra prb prc prd
596 , nfPR = nfPR_4 pra prb prc prd
597 }
598
599 {-# INLINE lengthPR_4 #-}
600 lengthPR_4 (P_4 n# _ _ _ _) = n#
601
602 {-# INLINE emptyPR_4 #-}
603 emptyPR_4 pra prb prc prd = traceFn "emptyPR_4" $
604 P_4 0# (emptyPR pra)
605 (emptyPR prb)
606 (emptyPR prc)
607 (emptyPR prd)
608
609 {-# INLINE replicatePR_4 #-}
610 replicatePR_4 pra prb prc prd n# ~(a,b,c,d)
611 = traceFn "replicatePR_4" $
612 P_4 n# (replicatePR pra n# a)
613 (replicatePR prb n# b)
614 (replicatePR prc n# c)
615 (replicatePR prd n# d)
616
617 {-# INLINE replicatelPR_4 #-}
618 replicatelPR_4 pra prb prc prd segd (P_4 _ as bs cs ds)
619 = traceFn "replicatelPR_4" $
620 P_4 (elementsSegdPA# segd) (replicatelPR pra segd as)
621 (replicatelPR prb segd bs)
622 (replicatelPR prc segd cs)
623 (replicatelPR prd segd ds)
624
625 {-# INLINE repeatPR_4 #-}
626 repeatPR_4 pra prb prc prd n# len# (P_4 _ as bs cs ds)
627 = traceFn "repeatPR_4" $
628 P_4 (n# *# len#) (repeatPR pra n# len# as)
629 (repeatPR prb n# len# bs)
630 (repeatPR prc n# len# cs)
631 (repeatPR prd n# len# ds)
632
633 {-# INLINE repeatcPR_4 #-}
634 repeatcPR_4 pra prb prc prd n# ns segd (P_4 _ as bs cs ds)
635 = traceFn "repeatcPR_4" $
636 P_4 n# (repeatcPR pra n# ns segd as)
637 (repeatcPR prb n# ns segd bs)
638 (repeatcPR prc n# ns segd cs)
639 (repeatcPR prd n# ns segd ds)
640
641 {-# INLINE indexPR_4 #-}
642 indexPR_4 pra prb prc prd (P_4 n# as bs cs ds) i#
643 = traceFn "indexPR_4" $
644 (indexPR pra as i#,
645 indexPR prb bs i#,
646 indexPR prc cs i#,
647 indexPR prd ds i#)
648
649 {-# INLINE extractPR_4 #-}
650 extractPR_4 pra prb prc prd (P_4 _ as bs cs ds) i# n#
651 = traceFn "extractPR_4" $
652 P_4 n# (extractPR pra as i# n#)
653 (extractPR prb bs i# n#)
654 (extractPR prc cs i# n#)
655 (extractPR prd ds i# n#)
656
657 {-# INLINE bpermutePR_4 #-}
658 bpermutePR_4 pra prb prc prd n# (P_4 _ as bs cs ds) is
659 = traceFn "bpermutePR_4" $
660 P_4 n# (bpermutePR pra n# as is)
661 (bpermutePR prb n# bs is)
662 (bpermutePR prc n# cs is)
663 (bpermutePR prd n# ds is)
664
665 {-# INLINE appPR_4 #-}
666 appPR_4 pra prb prc prd (P_4 m# as1 bs1 cs1 ds1) (P_4 n# as2 bs2 cs2 ds2)
667 = traceFn "appPR_4" $
668 P_4 (m# +# n#) (appPR pra as1 as2)
669 (appPR prb bs1 bs2)
670 (appPR prc cs1 cs2)
671 (appPR prd ds1 ds2)
672
673 {-# INLINE applPR_4 #-}
674 applPR_4 pra prb prc prd is (P_4 m# as1 bs1 cs1 ds1) js (P_4 n# as2 bs2 cs2 ds2)
675 = traceFn "applPR_4" $
676 P_4 (m# +# n#) (applPR pra is as1 js as2)
677 (applPR prb is bs1 js bs2)
678 (applPR prc is cs1 js cs2)
679 (applPR prd is ds1 js ds2)
680
681 {-# INLINE packPR_4 #-}
682 packPR_4 pra prb prc prd (P_4 _ as bs cs ds) n# sel#
683 = traceFn "packPR_4" $
684 P_4 n# (packPR pra as n# sel#)
685 (packPR prb bs n# sel#)
686 (packPR prc cs n# sel#)
687 (packPR prd ds n# sel#)
688
689 {-# INLINE combine2PR_4 #-}
690 combine2PR_4 pra prb prc prd n# sel# is# (P_4 _ as1 bs1 cs1 ds1)
691 (P_4 _ as2 bs2 cs2 ds2)
692 = traceFn "combine2PR_4" $
693 P_4 n# (combine2PR pra n# sel# is# as1 as2)
694 (combine2PR prb n# sel# is# bs1 bs2)
695 (combine2PR prc n# sel# is# cs1 cs2)
696 (combine2PR prd n# sel# is# ds1 ds2)
697
698 {-# INLINE fromListPR_4 #-}
699 fromListPR_4 pra prb prc prd n# xs
700 = P_4 n# (fromListPR pra n# as)
701 (fromListPR prb n# bs)
702 (fromListPR prc n# cs)
703 (fromListPR prd n# ds)
704 where
705 (as,bs,cs,ds) = L.unzip4 xs
706
707 {-# INLINE nfPR_4 #-}
708 nfPR_4 pra prb prc prd (P_4 _ as bs cs ds)
709 = nfPR pra as
710 `seq` nfPR prb bs
711 `seq` nfPR prc cs
712 `seq` nfPR prd ds
713
714 dPR_5 :: PR a -> PR b -> PR c -> PR d -> PR e -> PR (a,b,c,d,e)
715 {-# INLINE dPR_5 #-}
716 dPR_5 pra prb prc prd pre
717 = PR {
718 lengthPR = lengthPR_5
719 , emptyPR = emptyPR_5 pra prb prc prd pre
720 , replicatePR = replicatePR_5 pra prb prc prd pre
721 , replicatelPR = replicatelPR_5 pra prb prc prd pre
722 , repeatPR = repeatPR_5 pra prb prc prd pre
723 , repeatcPR = repeatcPR_5 pra prb prc prd pre
724 , indexPR = indexPR_5 pra prb prc prd pre
725 , extractPR = extractPR_5 pra prb prc prd pre
726 , bpermutePR = bpermutePR_5 pra prb prc prd pre
727 , appPR = appPR_5 pra prb prc prd pre
728 , applPR = applPR_5 pra prb prc prd pre
729 , packPR = packPR_5 pra prb prc prd pre
730 , combine2PR = combine2PR_5 pra prb prc prd pre
731 , fromListPR = fromListPR_5 pra prb prc prd pre
732 , nfPR = nfPR_5 pra prb prc prd pre
733 }
734
735 {-# INLINE lengthPR_5 #-}
736 lengthPR_5 (P_5 n# _ _ _ _ _) = n#
737
738 {-# INLINE emptyPR_5 #-}
739 emptyPR_5 pra prb prc prd pre
740 = traceFn "emptyPR_5" $
741 P_5 0# (emptyPR pra)
742 (emptyPR prb)
743 (emptyPR prc)
744 (emptyPR prd)
745 (emptyPR pre)
746
747 {-# INLINE replicatePR_5 #-}
748 replicatePR_5 pra prb prc prd pre n# ~(a,b,c,d,e)
749 = traceFn "replicatePR_5" $
750 P_5 n# (replicatePR pra n# a)
751 (replicatePR prb n# b)
752 (replicatePR prc n# c)
753 (replicatePR prd n# d)
754 (replicatePR pre n# e)
755
756 {-# INLINE replicatelPR_5 #-}
757 replicatelPR_5 pra prb prc prd pre segd (P_5 _ as bs cs ds es)
758 = traceFn "replicatelPR_5" $
759 P_5 (elementsSegdPA# segd) (replicatelPR pra segd as)
760 (replicatelPR prb segd bs)
761 (replicatelPR prc segd cs)
762 (replicatelPR prd segd ds)
763 (replicatelPR pre segd es)
764
765 {-# INLINE repeatPR_5 #-}
766 repeatPR_5 pra prb prc prd pre n# len# (P_5 _ as bs cs ds es)
767 = traceFn "repeatPR_5" $
768 P_5 (n# *# len#) (repeatPR pra n# len# as)
769 (repeatPR prb n# len# bs)
770 (repeatPR prc n# len# cs)
771 (repeatPR prd n# len# ds)
772 (repeatPR pre n# len# es)
773
774 {-# INLINE repeatcPR_5 #-}
775 repeatcPR_5 pra prb prc prd pre n# ns segd (P_5 _ as bs cs ds es)
776 = traceFn "repeatcPR_5" $
777 P_5 n# (repeatcPR pra n# ns segd as)
778 (repeatcPR prb n# ns segd bs)
779 (repeatcPR prc n# ns segd cs)
780 (repeatcPR prd n# ns segd ds)
781 (repeatcPR pre n# ns segd es)
782
783 {-# INLINE indexPR_5 #-}
784 indexPR_5 pra prb prc prd pre (P_5 n# as bs cs ds es) i#
785 = traceFn "indexPR_5" $
786 (indexPR pra as i#,
787 indexPR prb bs i#,
788 indexPR prc cs i#,
789 indexPR prd ds i#,
790 indexPR pre es i#)
791
792 {-# INLINE extractPR_5 #-}
793 extractPR_5 pra prb prc prd pre (P_5 _ as bs cs ds es) i# n#
794 = traceFn "extractPR_5" $
795 P_5 n# (extractPR pra as i# n#)
796 (extractPR prb bs i# n#)
797 (extractPR prc cs i# n#)
798 (extractPR prd ds i# n#)
799 (extractPR pre es i# n#)
800
801 {-# INLINE bpermutePR_5 #-}
802 bpermutePR_5 pra prb prc prd pre n# (P_5 _ as bs cs ds es) is
803 = traceFn "bpermutePR_5" $
804 P_5 n# (bpermutePR pra n# as is)
805 (bpermutePR prb n# bs is)
806 (bpermutePR prc n# cs is)
807 (bpermutePR prd n# ds is)
808 (bpermutePR pre n# es is)
809
810 {-# INLINE appPR_5 #-}
811 appPR_5 pra prb prc prd pre (P_5 m# as1 bs1 cs1 ds1 es1)
812 (P_5 n# as2 bs2 cs2 ds2 es2)
813 = traceFn "appPR_5" $
814 P_5 (m# +# n#) (appPR pra as1 as2)
815 (appPR prb bs1 bs2)
816 (appPR prc cs1 cs2)
817 (appPR prd ds1 ds2)
818 (appPR pre es1 es2)
819
820 {-# INLINE applPR_5 #-}
821 applPR_5 pra prb prc prd pre is (P_5 m# as1 bs1 cs1 ds1 es1)
822 js (P_5 n# as2 bs2 cs2 ds2 es2)
823 = traceFn "applPR_5" $
824 P_5 (m# +# n#) (applPR pra is as1 js as2)
825 (applPR prb is bs1 js bs2)
826 (applPR prc is cs1 js cs2)
827 (applPR prd is ds1 js ds2)
828 (applPR pre is es1 js es2)
829
830 {-# INLINE packPR_5 #-}
831 packPR_5 pra prb prc prd pre (P_5 _ as bs cs ds es) n# sel#
832 = traceFn "packPR_5" $
833 P_5 n# (packPR pra as n# sel#)
834 (packPR prb bs n# sel#)
835 (packPR prc cs n# sel#)
836 (packPR prd ds n# sel#)
837 (packPR pre es n# sel#)
838
839 {-# INLINE combine2PR_5 #-}
840 combine2PR_5 pra prb prc prd pre n# sel# is# (P_5 _ as1 bs1 cs1 ds1 es1)
841 (P_5 _ as2 bs2 cs2 ds2 es2)
842 = traceFn "combine2PR_5" $
843 P_5 n# (combine2PR pra n# sel# is# as1 as2)
844 (combine2PR prb n# sel# is# bs1 bs2)
845 (combine2PR prc n# sel# is# cs1 cs2)
846 (combine2PR prd n# sel# is# ds1 ds2)
847 (combine2PR pre n# sel# is# es1 es2)
848
849 {-# INLINE fromListPR_5 #-}
850 fromListPR_5 pra prb prc prd pre n# xs
851 = P_5 n# (fromListPR pra n# as)
852 (fromListPR prb n# bs)
853 (fromListPR prc n# cs)
854 (fromListPR prd n# ds)
855 (fromListPR pre n# es)
856 where
857 (as,bs,cs,ds,es) = L.unzip5 xs
858
859 {-# INLINE nfPR_5 #-}
860 nfPR_5 pra prb prc prd pre (P_5 _ as bs cs ds es)
861 = nfPR pra as
862 `seq` nfPR prb bs
863 `seq` nfPR prc cs
864 `seq` nfPR prd ds
865 `seq` nfPR pre es
866
867 data Sum2 a b = Alt2_1 a | Alt2_2 b
868 data Sum3 a b c = Alt3_1 a | Alt3_2 b | Alt3_3 c
869
870 data instance PArray (Sum2 a b)
871 = PSum2 Int# PArray_Int# PArray_Int# (PArray a)
872 (PArray b)
873
874 data instance PArray (Sum3 a b c)
875 = PSum3 Int# PArray_Int# PArray_Int# (PArray a)
876 (PArray b)
877 (PArray c)
878
879 dPR_Sum2 :: PR a -> PR b -> PR (Sum2 a b)
880 {-# INLINE dPR_Sum2 #-}
881 dPR_Sum2 pra prb = PR {
882 lengthPR = lengthPR_Sum2
883 , emptyPR = emptyPR_Sum2 pra prb
884 , replicatePR = replicatePR_Sum2 pra prb
885 , replicatelPR = replicatelPR_Sum2 pra prb
886 , repeatPR = repeatPR_Sum2 pra prb
887 , indexPR = indexPR_Sum2 pra prb
888 , bpermutePR = bpermutePR_Sum2 pra prb
889 , appPR = appPR_Sum2 pra prb
890 , applPR = applPR_Sum2 pra prb
891 , packPR = packPR_Sum2 pra prb
892 , combine2PR = combine2PR_Sum2 pra prb
893 }
894
895 {-# INLINE lengthPR_Sum2 #-}
896 lengthPR_Sum2 (PSum2 n# _ _ _ _) = n#
897
898 {-# INLINE emptyPR_Sum2 #-}
899 emptyPR_Sum2 pra prb
900 = traceFn "emptyPR_Sum2" $
901 PSum2 0# emptyPA_Int# emptyPA_Int# (emptyPR pra) (emptyPR prb)
902
903 {-# INLINE replicatePR_Sum2 #-}
904 replicatePR_Sum2 pra prb n# p
905 = traceFn "replicatePR_Sum2" $
906 PSum2 n# (replicatePA_Int# n# (case p of Alt2_1 _ -> 0#
907 Alt2_2 _ -> 1#))
908 (upToPA_Int# n#)
909 (case p of Alt2_1 x -> replicatePR pra n# x
910 _ -> emptyPR pra)
911 (case p of Alt2_2 y -> replicatePR prb n# y
912 _ -> emptyPR prb)
913
914 {-# INLINE replicatelPR_Sum2 #-}
915 replicatelPR_Sum2 pra prb segd (PSum2 m# sel# is# as bs)
916 = traceFn "replicatelPR_Sum2" $
917 PSum2 (elementsSegdPA# segd) sel' is' as' bs'
918 where
919 as' = replicatelPR pra lsegd as
920 bs' = replicatelPR prb rsegd bs
921 sel' = replicatelPA_Int# segd sel#
922 llens = pack'PA_Int# lens (selectPA_Int# sel# 0#)
923 rlens = pack'PA_Int# lens (selectPA_Int# sel# 1#)
924 lsegd = lengthsToSegdPA# llens
925 rsegd = lengthsToSegdPA# rlens
926 is' = selectorToIndices2PA# sel'
927
928 lens = lengthsSegdPA# segd
929
930 {-# INLINE repeatPR_Sum2 #-}
931 repeatPR_Sum2 pra prb n# len# (PSum2 m# sel# is# as bs)
932 = traceFn "repeatPR_Sum2" $
933 PSum2 (n# *# len#) sel' is' as' bs'
934 where
935 as' = repeatPR pra n# (lengthPR pra as) as
936 bs' = repeatPR prb n# (lengthPR prb bs) bs
937 sel' = repeatPA_Int# n# len# sel#
938 is' = selectorToIndices2PA# sel'
939
940 {-# INLINE indexPR_Sum2 #-}
941 indexPR_Sum2 pra prb (PSum2 n# sel# is# as bs) i#
942 = traceFn "indexPR_Sum2" $
943 case indexPA_Int# sel# i# of
944 0# -> Alt2_1 (indexPR pra as (indexPA_Int# is# i#))
945 _ -> Alt2_2 (indexPR prb bs (indexPA_Int# is# i#))
946
947 bpermutePR_Sum2 :: PR a -> PR b -> Int# -> PArray (Sum2 a b) -> PArray_Int# -> PArray (Sum2 a b)
948 bpermutePR_Sum2 pra prb _ _ is = traceFn "bpermutePR_Sum2" $
949 error "bpermutePR_Sum2 nyi"
950
951 appPR_Sum2 pra prb (PSum2 n1# sel1# _ as1 bs1) (PSum2 n2# sel2# _ as2 bs2) = traceFn "appPR_Sum2" $
952 PSum2 (n1# +# n2#) (appPA_Int# sel1# sel2#) (error "ind in appPR_Sum2 nyi") (appPR pra as1 as2) (appPR prb bs1 bs2)
953
954
955 applPR_Sum2 pra prb _ _ = error "applPR_Sum2 nyi"
956
957 packPR_Sum2 :: PR a -> PR b -> PArray (Sum2 a b) -> Int# -> PArray_Bool# -> PArray (Sum2 a b)
958 packPR_Sum2 pra prb (PSum2 n# sel# _ as bs) m# flags
959 = traceFn "packPR_Sum2" $
960 PSum2 m# sel' is as' bs'
961 where
962 sel' = packPA_Int# sel# m# flags
963
964 aFlags = packPA_Bool# flags (lengthPR pra as) (selectPA_Int# sel# 0#)
965 bFlags = packPA_Bool# flags (lengthPR prb bs) (selectPA_Int# sel# 1#)
966 !k# = truesPA_Bool# bFlags
967
968 as' = packPR pra as (m# -# k#) aFlags
969 bs' = packPR prb bs k# bFlags
970 is = error "packPR_Sum2 index not impl"
971
972 combine2PR_Sum2:: PR a -> PR b -> Int# -> PArray_Int# -> PArray_Int#
973 -> PArray (Sum2 a b) -> PArray (Sum2 a b) -> PArray (Sum2 a b)
974 combine2PR_Sum2 pra prb n# sel# is# (PSum2 m1# sel1# _ as1 bs1) (PSum2 m2# sel2# _ as2 bs2) = traceFn "combine2PR_Sum2" $
975 case (sel'Bool, nsel'Bool) of
976 (s1#, s2#) -> traceArgs ("combinePR_Sum\nn = " ++ show (I# n#) ++ "\n" ++
977 "m1 = " ++ show (I# m1#) ++ "\n" ++
978 "m2 = " ++ show (I# m2#) ++ "\n" ++
979 "as# = " ++ show (I# (lengthPR pra as1)) ++ " " ++ show (I# (lengthPR pra as2)) ++ "\n" ++
980 "bs# = " ++ show (I# (lengthPR prb bs1)) ++ " " ++ show (I# (lengthPR prb bs2)) ++ "\n" ++
981 "sel = " ++ show sel# ++ "\n" ++
982 "sel1 = " ++ show sel1# ++ "\n" ++
983 "sel2 = " ++ show sel2# ++ "\n" ++
984 "s1# = " ++ show s1# ++ "\n" ++
985 "s2# = " ++ show s2# ++ "\n" ++
986 "selB = " ++ show sel'Bool ++ "\n" ++
987 "nselB = " ++ show nsel'Bool ++ "\n" ++
988 "sel' = " ++ show sel' ++ "\n"
989 )
990 $
991 PSum2 n# sel' (error "combine2PR_Sum2 index nyi") as' bs'
992 where
993 !as# = lengthPR pra as1 +# lengthPR pra as2
994 !bs# = lengthPR prb bs1 +# lengthPR prb bs2
995 asel = packPA_Int# sel# as# s1#
996 bsel = packPA_Int# sel# bs# s2#
997 as' = trace ("cb1: " ++ show asel) $ combine2PR pra as# asel is# as1 as2
998 bs' = trace ("cb2: " ++ show bsel) $ combine2PR prb bs# bsel is# bs1 bs2
999 where
1000 sel' = combine2PA_Int# n# sel# is# sel1# sel2#
1001 sel'Bool = selectPA_Int# sel' 0#
1002 nsel'Bool = selectPA_Int# sel' 1#
1003
1004
1005 dPR_Sum3 :: PR a -> PR b -> PR c -> PR (Sum3 a b c)
1006 {-# INLINE dPR_Sum3 #-}
1007 dPR_Sum3 pra prb prc
1008 = PR {
1009 lengthPR = lengthPR_Sum3
1010 , emptyPR = emptyPR_Sum3 pra prb prc
1011 , replicatePR = replicatePR_Sum3 pra prb prc
1012 , indexPR = indexPR_Sum3 pra prb prc
1013 }
1014
1015 {-# INLINE lengthPR_Sum3 #-}
1016 lengthPR_Sum3 (PSum3 n# _ _ _ _ _) = n#
1017
1018 {-# INLINE emptyPR_Sum3 #-}
1019 emptyPR_Sum3 pra prb prc
1020 = traceFn "emptyPR_Sum3\n" $
1021 PSum3 0# emptyPA_Int# emptyPA_Int# (emptyPR pra)
1022 (emptyPR prb)
1023 (emptyPR prc)
1024
1025 {-# INLINE replicatePR_Sum3 #-}
1026 replicatePR_Sum3 pra prb prc n# p
1027 = traceFn "replicatePR_Sum3\n" $
1028 PSum3 n# (replicatePA_Int# n# (case p of Alt3_1 _ -> 0#
1029 Alt3_2 _ -> 1#
1030 Alt3_3 _ -> 2#))
1031 (upToPA_Int# n#)
1032 (case p of Alt3_1 x -> replicatePR pra n# x
1033 _ -> emptyPR pra)
1034 (case p of Alt3_2 x -> replicatePR prb n# x
1035 _ -> emptyPR prb)
1036 (case p of Alt3_3 x -> replicatePR prc n# x
1037 _ -> emptyPR prc)
1038
1039 {-# INLINE indexPR_Sum3 #-}
1040 indexPR_Sum3 pra prb prc (PSum3 n# sel# is# as bs cs) i#
1041 = traceFn "indexPR_Sum3\n" $
1042 case indexPA_Int# sel# i# of
1043 0# -> Alt3_1 (indexPR pra as (indexPA_Int# is# i#))
1044 1# -> Alt3_2 (indexPR prb bs (indexPA_Int# is# i#))
1045 _ -> Alt3_3 (indexPR prc cs (indexPA_Int# is# i#))
1046
1047 data instance PArray (PArray a)
1048 = PNested Int# PArray_Int# PArray_Int# (PArray a)
1049
1050 dPR_PArray :: PR a -> PR (PArray a)
1051 {-# INLINE dPR_PArray #-}
1052 dPR_PArray pr = PR {
1053 lengthPR = lengthPR_PArray
1054 , emptyPR = emptyPR_PArray pr
1055 , replicatePR = replicatePR_PArray pr
1056 , replicatelPR = replicatelPR_PArray pr
1057 , repeatPR = repeatPR_PArray pr
1058 , indexPR = indexPR_PArray pr
1059 , extractPR = extractPR_PArray pr
1060 , bpermutePR = bpermutePR_PArray pr
1061 , appPR = appPR_PArray pr
1062 , applPR = applPR_PArray pr
1063 , packPR = packPR_PArray pr
1064 , combine2PR = combine2PR_PArray pr
1065 }
1066
1067 {-# INLINE lengthPR_PArray #-}
1068 lengthPR_PArray (PNested n# _ _ _) = n#
1069
1070 {-# INLINE nested_lengthPA #-}
1071 nested_lengthPA xss = traceFn "nested_lengthPA\n" $
1072 I# (lengthPR_PArray xss)
1073
1074 {-# INLINE emptyPR_PArray #-}
1075 emptyPR_PArray pr = traceFn "emptyPR_PArray\n" $
1076 PNested 0# emptyPA_Int# emptyPA_Int# (emptyPR pr)
1077
1078 {-# INLINE replicatePR_PArray #-}
1079 replicatePR_PArray pr n# xs
1080 = traceFn "replicatePR_PArray\n" $
1081 PNested n# (replicatePA_Int# n# m#)
1082 (enumFromStepLenPA_Int# 0# m# n#)
1083 (repeatPR pr n# m# xs)
1084 where
1085 !m# = lengthPR pr xs
1086
1087 {-# INLINE indexPR_PArray #-}
1088 indexPR_PArray pr (PNested m# lens idxs xs) i#
1089 = extractPR pr xs (indexPA_Int# idxs i#)
1090 (indexPA_Int# lens i#)
1091
1092 {-# INLINE extractPR_PArray #-}
1093 extractPR_PArray pr (PNested m# lens idxs xs) i# n#
1094 = PNested n# lens' idxs' (extractPR pr xs (indexPA_Int# idxs i#)
1095 (sumPA_Int# lens'))
1096 where
1097 lens' = extractPA_Int# lens i# n#
1098 idxs' = unsafe_scanPA_Int# (+) 0 lens'
1099
1100 {-# INLINE bpermutePR_PArray #-}
1101 -- FIXME: this doesn't look right
1102 bpermutePR_PArray pr m# (PNested n# xslens xsInds xs) is = traceFn "bpermutePR_PArray\n" $
1103 PNested n# xslens' xsInds' xs'
1104 where
1105 xslens' = bpermutePA_Int# xslens is
1106 xsInds' = unsafe_scanPA_Int# (+) 0 xslens'
1107 is1 = bpermutePA_Int# xsInds is
1108 is2 = unsafe_zipWithPA_Int# (\x -> \y -> x + y - 1) xslens' is1
1109 ps = enumFromToEachPA_Int# (lengthPR pr xs) is1 is2
1110 xs' = bpermutePR pr (lengthPA_Int# ps) xs ps
1111
1112 _dummy :: Int#
1113 !_dummy = m#
1114
1115 {-# INLINE appPR_PArray #-}
1116 appPR_PArray pr (PNested n# xslens xsInds xs) (PNested m# yslens ysInds ys) = traceFn "appPR_PArray\n" $
1117 PNested (n# +# m#) (appPA_Int# xslens yslens) (appPA_Int# xsInds ysInds) (appPR pr xs ys)
1118
1119 {-# INLINE applPR_PArray #-}
1120 -- applPR_PArray:: PR a -> USegd -> PArray a -> USegd -> PArray a -> PArray a
1121 applPR_PArray pr is1 xn@(PNested n# xslens xsInds xs) is2 yn@(PNested m# yslens ysInds ys) = traceFn "applPR_PArray\n" $
1122 traceArgs ("applPR_PArray:\n" ++
1123 show is1 ++ "\n" ++
1124 show xslens ++ "\n" ++
1125 show is2 ++ "\n" ++
1126 show yslens ++ "\n" ++
1127 show lens) $
1128 PNested (n# +# m#) lens ids xys
1129 where
1130 lens = appPA_Int# xslens yslens
1131 xsSegd = sumPAs_Int# is1 xslens
1132 ysSegd = sumPAs_Int# is2 yslens
1133 ids = unsafe_scanPA_Int# (+) 0 lens
1134 !xlen# = lengthPR pr xs
1135 !ylen# = lengthPR pr ys
1136 !len# = xlen# +# ylen#
1137 (PNested _ _ _ xys) = combine2PR_PArray pr len# isel (error "tmp ind nyi")
1138 (PNested n# xsSegd (error "bla1") xs) (PNested n# ysSegd (error "bla1") ys)
1139 isel = unsafe_mapPA_Int# (fromBool . even)
1140 $ enumFromToPA_Int# 1# (2# *# lengthPA_Int# xslens)
1141
1142
1143
1144 {-# INLINE repeatPR_PArray #-}
1145 repeatPR_PArray pr n# len# (PNested _ lens _ xs)
1146 = traceFn "repeatPR_PArray\n" $
1147 PNested (n# *# len#) lens'
1148 (unsafe_scanPA_Int# (+) 0 lens')
1149 (repeatPR pr n# (lengthPR pr xs) xs)
1150 where
1151 lens' = repeatPA_Int# n# len# lens
1152
1153 {-# INLINE replicatelPR_PArray #-}
1154 replicatelPR_PArray pr segd {-n# ns-} (PNested _ lens idxs xs)
1155 = traceFn "replicatelPR_PArray\n" $
1156 PNested (elementsSegdPA# segd) new_lens new_idxs
1157 $ repeatcPR pr len rlens (mkSegdPA# lens idxs (lengthPR pr xs)) xs
1158 where
1159 new_lens = replicatelPA_Int# segd lens
1160 new_idxs = unsafe_scanPA_Int# (+) 0 new_lens
1161 !len = sumPA_Int# (unsafe_zipWithPA_Int# (*) rlens lens)
1162
1163 rlens = lengthsSegdPA# segd
1164 {-
1165 PNested n# new_lens new_idxs (bpermutePR pr len xs indices)
1166 where
1167 new_lens = replicatelPA_Int# n# ns lens
1168 new_idxs = unsafe_scanPA_Int# (+) 0 new_lens
1169 starts = replicatelPA_Int# n# ns idxs
1170 ends = replicatelPA_Int# n# ns
1171 $ unsafe_zipWithPA_Int# (\i l -> i+l-1) idxs lens
1172
1173 len = sumPA_Int# (unsafe_zipWithPA_Int# (*) ns lens)
1174 indices = enumFromToEachPA_Int# len starts ends
1175 -}
1176
1177 {-# INLINE packPR_PArray #-}
1178 packPR_PArray pr (PNested _ lens _ xs) n# bs
1179 = traceFn "packPR_PArray\n" $
1180 PNested n# lens' idxs'
1181 (packPR pr xs (sumPA_Int# lens')
1182 (replicatelPA_Bool# (lengthsToSegdPA# lens) bs))
1183 where
1184 lens' = packPA_Int# lens n# bs
1185 idxs' = unsafe_scanPA_Int# (+) 0 lens'
1186
1187 {-# INLINE combine2PR_PArray #-}
1188 combine2PR_PArray pr n# sel is (PNested m1# lens1 idxs1 xs)
1189 (PNested m2# lens2 idxs2 ys)
1190 = traceFn ("combine2PR_PArray") $
1191 traceArgs ("combine2PR_PArray args" ++ show (I# n#) ++ " "
1192 ++ show (I# m1#) ++ "\n "
1193 ++ show (I# m2#) ++ "\n "
1194 ++ show (lens1) ++ "\n"
1195 ++ show (lens2) ++ "\n"
1196 ++ show (sel') ++ "\n"
1197 ++ show (lens) ++ "\n"
1198 ++ show sel ++ "\n") $
1199 PNested n# lens idxs xys
1200 where
1201 xys = combine2PR pr len# sel' is' xs ys
1202 lens = combine2PA_Int# (m1# +# m2#) sel is lens1 lens2
1203 idxs = unsafe_scanPA_Int# (+) 0 lens
1204
1205 !xlen# = lengthPR pr xs
1206 !ylen# = lengthPR pr ys
1207 !len# = xlen# +# ylen#
1208
1209 sel' = replicatelPA_Int# (lengthsToSegdPA# lens) sel
1210 is' = selectorToIndices2PA# sel'
1211
1212 segdOfPA# :: PA a -> PArray (PArray a) -> Segd
1213 {-# INLINE_PA segdOfPA# #-}
1214 segdOfPA# pa (PNested _ lens idxs xs) = mkSegdPA# lens idxs (lengthPA# pa xs)
1215
1216 concatPA# :: PArray (PArray a) -> PArray a
1217 {-# INLINE_PA concatPA# #-}
1218 concatPA# (PNested _ _ _ xs) = traceFn "concatPA\n" $
1219 xs
1220