Make combine2 work with selectors
[packages/dph.git] / dph-prim-interface / Data / Array / Parallel / Unlifted.hs
1 {-# LANGUAGE TypeOperators, CPP #-}
2
3 #include "DPH_Header.h"
4
5 import Data.Array.Parallel.Base
6
7 import qualified Prelude as P
8 import Prelude ( Eq(..), Num(..), Bool(..), ($), (.) )
9
10 #include "DPH_Interface.h"
11
12 #define ASSERT assert __FILE__ __LINE__
13
14 assert :: P.String -> Int -> Bool -> a -> a
15 assert file line False _
16 = P.error $ file P.++ " (line " P.++ P.show line P.++ "): assertion failure"
17 assert _ _ _ x = x
18
19 class Elt a
20 instance Elt a => Elt [a]
21
22 type Array a = [a]
23 data Segd = Segd { segd_lengths :: [Int]
24 , segd_indices :: [Int]
25 , segd_elements :: Int
26 }
27
28 data Sel2 = Sel2 { sel2_tags :: [Int]
29 , sel2_indices :: [Int]
30 , sel2_elements0 :: Int
31 , sel2_elements1 :: Int
32 }
33
34 length = P.length
35 empty = []
36 replicate = P.replicate
37 repeat n _ xs = P.concat (replicate n xs)
38 (!:) = (P.!!)
39 extract xs i n = P.take n (P.drop i xs)
40 drop = P.drop
41 permute = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.permute"
42 bpermute xs ns = map (xs !:) ns
43 update = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.update"
44 (+:+) = (P.++)
45
46 mbpermute = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.mbpermute"
47 bpermuteDft = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.bpermuteDft"
48
49 interleave xs ys = P.concat [[x,y] | (x,y) <- P.zip xs ys]
50
51 mkSel2 = Sel2
52 tagsSel2 = sel2_tags
53 indicesSel2 = sel2_indices
54 elementsSel2_0 = sel2_elements0
55 elementsSel2_1 = sel2_elements1
56
57 pack xs bs = [x | (x,b) <- P.zip xs bs, b]
58
59 combine [] [] [] = []
60 combine (True : bs) (x : xs) ys = x : combine bs xs ys
61 combine (False : bs) xs (y : ys) = y : combine bs xs ys
62
63 combine2 sel xs ys = go (tagsSel2 sel) xs ys
64 where
65 go [] [] [] = []
66 go (0 : bs) (x : xs) ys = x : go bs xs ys
67 go (1 : bs) xs (y : ys) = y : go bs xs ys
68
69 map = P.map
70 filter = P.filter
71 zip = P.zipWith (:*:)
72 unzip = P.unzip . P.map unpairS
73 fsts = map fstS
74 snds = map sndS
75 zipWith = P.zipWith
76
77 fold = P.foldr -- or equivalently foldl
78 fold1 = P.foldr1 -- or equivalently foldr1
79 and = P.and
80 sum = P.sum
81 scan f z = P.init . P.scanl f z
82
83 indices_s segd = P.concat [[0 .. n-1] | n <- segd_lengths segd]
84 indexed xs = zip [0 .. length xs - 1] xs
85 enumFromTo m n = [m .. n]
86 enumFromThenTo m n s = [m, n..s]
87
88 enumFromStepLen i k 0 = []
89 enumFromStepLen i k n = i : enumFromStepLen (i+k) k (n-1)
90
91 enumFromStepLenEach size starts steps lens
92 = ASSERT (size == sum lens)
93 P.concat
94 $ P.zipWith3 (\x y z -> P.enumFromThenTo x (x+y) (x+y*z)) starts steps lens
95
96
97 randoms n = P.take n . System.Random.randoms
98 randomRs n r = P.take n . System.Random.randomRs r
99
100 nest :: Segd -> [a] -> [[a]]
101 nest (Segd ns is _) xs = go ns xs
102 where
103 go [] [] = []
104 go (n : ns) xs = let (ys, zs) = P.splitAt n xs
105 in ys : go ns zs
106
107 replicate_s segd xs
108 = P.concat
109 $ zipWith replicate (lengthsSegd segd) xs
110 replicate_rs n xs
111 = P.concat
112 $ P.map (P.replicate n) xs
113 append_s _ xd xs yd ys = P.concat (P.zipWith (P.++) (nest xd xs) (nest yd ys))
114
115 fold_s f z segd xs = P.map (P.foldr f z) (nest segd xs)
116 fold1_s f segd xs = P.map (P.foldr1 f) (nest segd xs)
117 fold_r f z segSize xs = P.error "FIXME GABI PLEASE PLEASE PLEASE"
118 sum_r segSize xs = P.error "FIXME GABI PLEASE PLEASE PLEASE"
119
120 lengthSegd = length . lengthsSegd
121 lengthsSegd = segd_lengths
122 indicesSegd = segd_indices
123 elementsSegd = segd_elements
124 mkSegd = Segd
125
126 class Elt a => IOElt a
127 hPut = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.hPut"
128 hGet = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.hGet"
129
130 toList x = x
131 fromList x = x
132
133 toList_s x = x
134 fromList_s x = x
135