Fix fusion for sumPA
[packages/dph.git] / dph-lifted-vseg / Data / Array / Parallel / PArray / PData / Double.hs
1 {-# LANGUAGE
2 CPP,
3 BangPatterns,
4 TypeFamilies,
5 FlexibleInstances, FlexibleContexts,
6 MultiParamTypeClasses,
7 StandaloneDeriving,
8 ExistentialQuantification #-}
9
10 #include "fusion-phases.h"
11
12 module Data.Array.Parallel.PArray.PData.Double where
13 import Data.Array.Parallel.PArray.PData.Base
14 import Data.Array.Parallel.PArray.PData.Nested
15 import qualified Data.Array.Parallel.Unlifted as U
16 import qualified Data.Vector as V
17 import qualified Data.Vector.Unboxed as VU
18 import Text.PrettyPrint
19
20 data instance PData Double
21 = PDouble !(U.Array Double)
22
23 deriving instance Show (PData Double)
24
25
26 instance PprPhysical (PData Double) where
27 pprp (PDouble vec)
28 = text "PDouble"
29 <+> text (show $ U.toList vec)
30
31
32 instance PprVirtual (PData Double) where
33 pprv (PDouble vec)
34 = text (show $ U.toList vec)
35
36
37 instance PR Double where
38 {-# INLINE_PDATA validPR #-}
39 validPR _
40 = True
41
42 {-# INLINE_PDATA emptyPR #-}
43 emptyPR
44 = PDouble U.empty
45
46 {-# INLINE_PDATA nfPR #-}
47 nfPR (PDouble xx)
48 = xx `seq` ()
49
50 {-# INLINE_PDATA lengthPR #-}
51 lengthPR (PDouble xx)
52 = U.length xx
53
54 {-# INLINE_PDATA replicatePR #-}
55 replicatePR len x
56 = PDouble (U.replicate len x)
57
58 {-# INLINE_PDATA replicatesPR #-}
59 replicatesPR lens (PDouble arr)
60 = PDouble (U.replicate_s (U.lengthsToSegd lens) arr)
61
62 {-# INLINE_PDATA indexPR #-}
63 indexPR (PDouble arr) ix
64 = arr `VU.unsafeIndex` ix
65
66 {-# INLINE_PDATA indexlPR #-}
67 indexlPR _ arr@(PNested vsegd psegdatas) (PInt ixs)
68 = PDouble $ U.zipWith get (pnested_vsegids arr) ixs
69 where
70 -- Unbox these vectors outside the get loop.
71 !psegsrcids = U.takeVSegidsOfVSegd vsegd
72 !psegstarts = U.startsSSegd $ U.takeSSegdOfVSegd vsegd
73 !psegvecs = V.map (\(PDouble vec) -> vec) psegdatas
74
75 -- Lookup a single element from a virtual segment.
76 get !vsegid !ix
77 = let !psegsrcid = psegsrcids `VU.unsafeIndex` vsegid
78 !psegvec = psegvecs `V.unsafeIndex` psegsrcid
79 !psegstart = psegstarts `VU.unsafeIndex` vsegid
80 !elemIx = psegstart + ix
81 !elemVal = psegvec `VU.unsafeIndex` elemIx
82 in elemVal
83
84 {-# INLINE_PDATA extractPR #-}
85 extractPR (PDouble arr) start len
86 = PDouble (U.extract arr start len)
87
88 {-# INLINE_PDATA extractsPR #-}
89 extractsPR arrs ussegd
90 = let segsrcs = U.sourcesSSegd ussegd
91 segstarts = U.startsSSegd ussegd
92 seglens = U.lengthsSSegd ussegd
93 in PDouble (uextracts (V.map (\(PDouble arr) -> arr) arrs)
94 segsrcs segstarts seglens)
95
96 {-# INLINE_PDATA appendPR #-}
97 appendPR (PDouble arr1) (PDouble arr2)
98 = PDouble (arr1 U.+:+ arr2)
99
100 {-# INLINE_PDATA appendsPR #-}
101 appendsPR segdResult segd1 (PDouble arr1) segd2 (PDouble arr2)
102 = PDouble $ U.append_s segdResult segd1 arr1 segd2 arr2
103
104 {-# INLINE_PDATA packByTagPR #-}
105 packByTagPR (PDouble arr1) arrTags tag
106 = PDouble (U.packByTag arr1 arrTags tag)
107
108 {-# INLINE_PDATA combine2PR #-}
109 combine2PR sel (PDouble arr1) (PDouble arr2)
110 = PDouble (U.combine2 (U.tagsSel2 sel)
111 (U.repSel2 sel)
112 arr1 arr2)
113
114 {-# INLINE_PDATA fromVectorPR #-}
115 fromVectorPR xx
116 = PDouble (U.fromList $ V.toList xx)
117
118 {-# INLINE_PDATA toVectorPR #-}
119 toVectorPR (PDouble arr)
120 = V.fromList $ U.toList arr
121
122 {-# INLINE_PDATA fromUArrayPR #-}
123 fromUArrayPR xx
124 = PDouble xx
125
126 {-# INLINE_PDATA toUArrayPR #-}
127 toUArrayPR (PDouble xx)
128 = xx