Add replicatedVSegd as a target for RULES
[packages/dph.git] / dph-prim-interface / Data / Array / Parallel / Unlifted.hs
1 {-# LANGUAGE TypeOperators, CPP #-}
2
3 -- | WARNING: This is a fake module and most of the functions here will just `error` if called.
4 --
5 -- This "dph-prim-interface" module provides an API and a partial reference
6 -- implentation for the unlifted array primitives used by DPH. This code is
7 -- not used during runtime.
8 --
9 -- Client programs should use the @dph-prim-seq@ or @dph-prim-par@ packages
10 -- instead, provide the same API and contain real code.
11 --
12
13 -- NOTE: The API is enforced by the DPH_Header.h and DPH_Interface.h headers.
14 -- The dph-prim-interface, dph-prim-seq, and dph-prim-par modules all import
15 -- the same headers so we can be sure we're presenting the same API.
16 #include "DPH_Header.h"
17
18 import qualified Prelude as P
19 import Prelude ( Eq(..), Num(..), Bool(..), ($), (.) )
20
21 #include "DPH_Interface.h"
22
23 -- NOTE -----------------------------------------------------------------------
24 -- See DPH_Interface.h for documentation.
25 -- As these functions are defined multiple times in different packages,
26 -- we keep all the docs there.
27 --
28 -- The definitions should appear in the same order as they are defined in DPH_Interface.h
29 --
30 #define ASSERT assert __FILE__ __LINE__
31
32 assert :: P.String -> Int -> Bool -> a -> a
33 assert file line False _
34 = P.error $ file P.++ " (line " P.++ P.show line P.++ "): assertion failure"
35 assert _ _ _ x = x
36
37 notImplemented :: P.String -> a
38 notImplemented fnName
39 = P.error $ "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted." P.++ fnName
40
41
42 -- Types ----------------------------------------------------------------------
43 class Elt a
44 instance Elt a => Elt [a]
45 type Array a = [a]
46
47
48 -- Constructors ---------------------------------------------------------------
49 empty = []
50
51 (+:+) = (P.++)
52
53 append_s _ xd xs yd ys
54 = P.concat (P.zipWith (P.++) (nest xd xs) (nest yd ys))
55
56 replicate
57 = P.replicate
58
59 replicate_s segd xs
60 = P.concat
61 $ zipWith replicate (lengthsSegd segd) xs
62
63 replicate_rs n xs
64 = P.concat
65 $ P.map (P.replicate n) xs
66
67 repeat n _ xs
68 = P.concat (replicate n xs)
69
70 indexed xs
71 = zip [0 .. length xs - 1] xs
72
73 indices_s segd
74 = P.concat [[0 .. n-1] | n <- segd_lengths segd]
75
76 enumFromTo m n = [m .. n]
77 enumFromThenTo m n s = [m, n..s]
78 enumFromStepLen i k 0 = []
79 enumFromStepLen i k n = i : enumFromStepLen (i+k) k (n-1)
80
81 enumFromStepLenEach size starts steps lens
82 = ASSERT (size == sum lens)
83 P.concat
84 $ P.zipWith3 (\x y z -> P.enumFromThenTo x (x+y) (x+y*z)) starts steps lens
85
86
87 -- Projections ----------------------------------------------------------------
88 length = P.length
89 index _ = (P.!!)
90 indexs_avs = notImplemented "indexs_avs"
91
92 extract xs i n = P.take n (P.drop i xs)
93 extracts_nss = notImplemented "extract_nss"
94 extracts_ass = notImplemented "extract_ass"
95 extracts_avs = notImplemented "extract_avs"
96
97 drop = P.drop
98
99
100 -- Update ---------------------------------------------------------------------
101 update = notImplemented "update"
102
103
104 -- Permutation ----------------------------------------------------------------
105 permute = notImplemented "permute"
106 bpermute xs ns = map (xs P.!!) ns
107 mbpermute = notImplemented "mbpermute"
108 bpermuteDft = notImplemented "bpermuteDft"
109
110
111 -- Zipping and Unzipping ------------------------------------------------------
112 zip = P.zip
113 zip3 = P.zip3
114 unzip = P.unzip
115 unzip3 = P.unzip3
116 fsts = map P.fst
117 snds = map P.snd
118
119
120 -- Map and zipWith ------------------------------------------------------------
121 map = P.map
122 zipWith = P.zipWith
123
124
125 -- Scans and Folds -----------------------------------------------------------
126 scan f z
127 = P.init . P.scanl f z
128
129 fold = P.foldr
130
131 fold_s f z segd xs
132 = P.map (P.foldr f z) (nest segd xs)
133
134 fold_ss = notImplemented "fold_ss"
135
136 fold_r f z segSize xs
137 = notImplemented "fold_r"
138
139 fold1 = P.foldr1
140
141 fold1_s f segd xs
142 = P.map (P.foldr1 f) (nest segd xs)
143
144 fold1_ss = notImplemented "fold1_ss"
145
146 sum = P.sum
147
148 sum_r segSize xs
149 = notImplemented "sum_r"
150
151 and = P.and
152
153
154 -- Packing and Combining ------------------------------------------------------
155 pack xs bs
156 = [x | (x,b) <- P.zip xs bs, b]
157
158 filter = P.filter
159
160
161 -- Combine and Interleave -----------------------------------------------------
162 combine [] [] [] = []
163 combine (True : bs) (x : xs) ys = x : combine bs xs ys
164 combine (False : bs) xs (y : ys) = y : combine bs xs ys
165
166 combine2 tags _ xs ys = go tags xs ys
167 where
168 go [] [] [] = []
169 go (0 : bs) (x : xs) ys = x : go bs xs ys
170 go (1 : bs) xs (y : ys) = y : go bs xs ys
171
172 interleave xs ys = P.concat [[x,y] | (x,y) <- P.zip xs ys]
173
174
175 -- Selectors ------------------------------------------------------------------
176 data Sel2
177 = Sel2
178 { sel2_tags :: [Tag]
179 , sel2_indices :: [Int]
180 , sel2_elements0 :: Int
181 , sel2_elements1 :: Int }
182
183 mkSel2 tags idxs n0 n1 _
184 = Sel2 tags idxs n0 n1
185
186 tagsSel2 = sel2_tags
187 indicesSel2 = sel2_indices
188 elementsSel2_0 = sel2_elements0
189 elementsSel2_1 = sel2_elements1
190 repSel2 _ = ()
191
192
193 type SelRep2 = ()
194 mkSelRep2 _ = ()
195
196 indicesSelRep2 tags _
197 = P.zipWith pick tags
198 $ P.init
199 $ P.scanl add (0,0) tags
200 where
201 pick 0 (i,j) = i
202 pick 1 (i,j) = j
203
204 add (i,j) 0 = (i+1,j)
205 add (i,j) 1 = (i,j+1)
206
207 elementsSelRep2_0 tags _ = P.length [() | 0 <- tags]
208 elementsSelRep2_1 tags _ = P.length [() | 1 <- tags]
209
210
211
212 -- Segment Descriptors --------------------------------------------------------
213 data Segd
214 = Segd
215 { segd_lengths :: [Int]
216 , segd_indices :: [Int]
217 , segd_elements :: Int }
218
219 mkSegd = Segd
220 emptySegd = Segd [] [] 0
221 singletonSegd = notImplemented "singletonSegd"
222 validSegd = notImplemented "validSegd"
223 lengthSegd = length . lengthsSegd
224 lengthsSegd = segd_lengths
225 indicesSegd = segd_indices
226 elementsSegd = segd_elements
227
228
229 -- Scattered Segment Descriptors ----------------------------------------------
230 data SSegd
231 = SSegd
232 { ssegd_starts :: [Int]
233 , ssegd_sources :: [Int]
234 , ssegd_segd :: Segd }
235
236 mkSSegd = SSegd
237 validSSegd = notImplemented "validSSegd"
238 emptySSegd = SSegd [] [] emptySegd
239 singletonSSegd = notImplemented "singletonSSegd"
240 promoteSegdToSSegd = notImplemented "promoteSegdToSSegd"
241 isContiguousSSegd = notImplemented "isContiguousSSegd"
242 lengthOfSSegd = lengthSegd . ssegd_segd
243 lengthsOfSSegd = lengthsSegd . ssegd_segd
244 indicesOfSSegd = indicesSegd . ssegd_segd
245 startsOfSSegd = ssegd_starts
246 sourcesOfSSegd = ssegd_sources
247 getSegOfSSegd = notImplemented "getSegOfSSegd"
248 appendSSegd = notImplemented "appendSSegd"
249
250
251 -- Virtual Segment Descriptors ------------------------------------------------
252 data VSegd
253 = VSegd
254 { vsegd_vsegids :: [Int]
255 , vsegd_ssegd :: SSegd }
256
257 mkVSegd = VSegd
258 validVSegd = notImplemented "validSSegd"
259 emptyVSegd = VSegd [] emptySSegd
260 singletonVSegd = notImplemented "singletonVSegd"
261 replicatedVSegd = notImplemented "replicatedVSegd"
262 promoteSegdToVSegd = notImplemented "promoteSegdToVSegd"
263 promoteSSegdToVSegd = notImplemented "promoteSSegdToVSegd"
264 isContiguousVSegd = notImplemented "isContiguousVSegd"
265 isManifestVSegd = notImplemented "isManifestVSegd"
266 lengthOfVSegd = notImplemented "lengthOfVSegd"
267 takeVSegidsOfVSegd = vsegd_vsegids
268 takeVSegidsRedundantOfVSegd = vsegd_vsegids
269 takeSSegdOfVSegd = vsegd_ssegd
270 takeSSegdRedundantOfVSegd = vsegd_ssegd
271 takeLengthsOfVSegd = notImplemented "takeLengthsOfVSegd"
272 getSegOfVSegd = notImplemented "getSegOfVSegd"
273 demoteToSSegdOfVSegd = notImplemented "demoteToSSegdOfVSegd"
274 unsafeDemoteToSegdOfVSegd = notImplemented "unsafeDemoteToSegdOfVSegd"
275 updateVSegsOfVSegd = notImplemented "updateVSegsOfVSegd"
276 updateVSegsReachableOfVSegd = notImplemented "updateVSegsReachableOfVSegd"
277 appendVSegd = notImplemented "appendVSegd"
278 combine2VSegd = notImplemented "combine2VSegd"
279
280
281 -- 2D Arrays ------------------------------------------------------------------
282 class Elts a
283 type Arrays a = [[a]]
284 emptys = notImplemented "emptys"
285 lengths = notImplemented "lengths"
286 singletons = notImplemented "singletons"
287 unsafeIndexs = notImplemented "unsafeIndexs"
288 unsafeIndex2s = notImplemented "unsafeIndex2s"
289 appends = notImplemented "appends"
290 fromVectors = notImplemented "fromVectors"
291 toVectors = notImplemented "toVectors"
292
293
294 -- Random Arrays --------------------------------------------------------------
295 randoms n = P.take n . System.Random.randoms
296 randomRs n r = P.take n . System.Random.randomRs r
297
298
299 -- Array IO -------------------------------------------------------------------
300 class Elt a => IOElt a
301 hPut = notImplemented "hPut"
302 hGet = notImplemented "hGet"
303
304 toList x = x
305 fromList x = x
306
307
308 -- Other Stuff ----------------------------------------------------------------
309 nest :: Segd -> [a] -> [[a]]
310 nest (Segd ns is _) xs = go ns xs
311 where
312 go [] [] = []
313 go (n : ns) xs = let (ys, zs) = P.splitAt n xs
314 in ys : go ns zs
315
316 toList_s x = x
317 fromList_s x = x
318