Replace remaining occurences of basicUnsafeNewWith with basicUnsafeReplicate
[darcs-mirrors/vector.git] / Data / Vector / Unboxed / Base.hs
1 {-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}
2 {-# OPTIONS_HADDOCK hide #-}
3
4 -- |
5 -- Module : Data.Vector.Unboxed.Base
6 -- Copyright : (c) Roman Leshchinskiy 2009-2010
7 -- License : BSD-style
8 --
9 -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>
10 -- Stability : experimental
11 -- Portability : non-portable
12 --
13 -- Adaptive unboxed vectors: basic implementation
14 --
15
16 module Data.Vector.Unboxed.Base (
17 MVector(..), IOVector, STVector, Vector(..), Unbox
18 ) where
19
20 import qualified Data.Vector.Generic as G
21 import qualified Data.Vector.Generic.Mutable as M
22
23 import qualified Data.Vector.Primitive as P
24
25 import Control.Monad.Primitive
26 import Control.Monad ( liftM )
27
28 import Data.Word ( Word, Word8, Word16, Word32, Word64 )
29 import Data.Int ( Int8, Int16, Int32, Int64 )
30 import Data.Complex
31
32 import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp, mkTyCon )
33 import Data.Data ( Data(..) )
34
35 #include "vector.h"
36
37 data family MVector s a
38 data family Vector a
39
40 type IOVector = MVector RealWorld
41 type STVector s = MVector s
42
43 type instance G.Mutable Vector = MVector
44
45 class (G.Vector Vector a, M.MVector MVector a) => Unbox a
46
47 -- -----------------
48 -- Data and Typeable
49 -- -----------------
50
51 vectorTy :: String
52 vectorTy = "Data.Vector.Unboxed.Vector"
53
54 instance Typeable1 Vector where
55 typeOf1 _ = mkTyConApp (mkTyCon vectorTy) []
56
57 instance Typeable2 MVector where
58 typeOf2 _ = mkTyConApp (mkTyCon "Data.Vector.Unboxed.Mutable.MVector") []
59
60 instance (Data a, Unbox a) => Data (Vector a) where
61 gfoldl = G.gfoldl
62 toConstr _ = error "toConstr"
63 gunfold _ _ = error "gunfold"
64 dataTypeOf _ = G.mkType vectorTy
65 dataCast1 = G.dataCast
66
67 -- ----
68 -- Unit
69 -- ----
70
71 newtype instance MVector s () = MV_Unit Int
72 newtype instance Vector () = V_Unit Int
73
74 instance Unbox ()
75
76 instance M.MVector MVector () where
77 {-# INLINE basicLength #-}
78 {-# INLINE basicUnsafeSlice #-}
79 {-# INLINE basicOverlaps #-}
80 {-# INLINE basicUnsafeNew #-}
81 {-# INLINE basicUnsafeRead #-}
82 {-# INLINE basicUnsafeWrite #-}
83 {-# INLINE basicClear #-}
84 {-# INLINE basicSet #-}
85 {-# INLINE basicUnsafeCopy #-}
86 {-# INLINE basicUnsafeGrow #-}
87
88 basicLength (MV_Unit n) = n
89
90 basicUnsafeSlice i m (MV_Unit n) = MV_Unit m
91
92 basicOverlaps _ _ = False
93
94 basicUnsafeNew n = return (MV_Unit n)
95
96 basicUnsafeRead (MV_Unit _) _ = return ()
97
98 basicUnsafeWrite (MV_Unit _) _ () = return ()
99
100 basicClear _ = return ()
101
102 basicSet (MV_Unit _) () = return ()
103
104 basicUnsafeCopy (MV_Unit _) (MV_Unit _) = return ()
105
106 basicUnsafeGrow (MV_Unit n) m = return $ MV_Unit (n+m)
107
108 instance G.Vector Vector () where
109 {-# INLINE unsafeFreeze #-}
110 unsafeFreeze (MV_Unit n) = return $ V_Unit n
111
112 {-# INLINE basicLength #-}
113 basicLength (V_Unit n) = n
114
115 {-# INLINE basicUnsafeSlice #-}
116 basicUnsafeSlice i m (V_Unit n) = V_Unit m
117
118 {-# INLINE basicUnsafeIndexM #-}
119 basicUnsafeIndexM (V_Unit _) i = return ()
120
121 {-# INLINE basicUnsafeCopy #-}
122 basicUnsafeCopy (MV_Unit _) (V_Unit _) = return ()
123
124 {-# INLINE elemseq #-}
125 elemseq _ = seq
126
127
128 -- ---------------
129 -- Primitive types
130 -- ---------------
131
132 #define primMVector(ty,con) \
133 instance M.MVector MVector ty where { \
134 {-# INLINE basicLength #-} \
135 ; {-# INLINE basicUnsafeSlice #-} \
136 ; {-# INLINE basicOverlaps #-} \
137 ; {-# INLINE basicUnsafeNew #-} \
138 ; {-# INLINE basicUnsafeReplicate #-} \
139 ; {-# INLINE basicUnsafeRead #-} \
140 ; {-# INLINE basicUnsafeWrite #-} \
141 ; {-# INLINE basicClear #-} \
142 ; {-# INLINE basicSet #-} \
143 ; {-# INLINE basicUnsafeCopy #-} \
144 ; {-# INLINE basicUnsafeGrow #-} \
145 ; basicLength (con v) = M.basicLength v \
146 ; basicUnsafeSlice i n (con v) = con $ M.basicUnsafeSlice i n v \
147 ; basicOverlaps (con v1) (con v2) = M.basicOverlaps v1 v2 \
148 ; basicUnsafeNew n = con `liftM` M.basicUnsafeNew n \
149 ; basicUnsafeReplicate n x = con `liftM` M.basicUnsafeReplicate n x \
150 ; basicUnsafeRead (con v) i = M.basicUnsafeRead v i \
151 ; basicUnsafeWrite (con v) i x = M.basicUnsafeWrite v i x \
152 ; basicClear (con v) = M.basicClear v \
153 ; basicSet (con v) x = M.basicSet v x \
154 ; basicUnsafeCopy (con v1) (con v2) = M.basicUnsafeCopy v1 v2 \
155 ; basicUnsafeGrow (con v) n = con `liftM` M.basicUnsafeGrow v n }
156
157 #define primVector(ty,con,mcon) \
158 instance G.Vector Vector ty where { \
159 {-# INLINE unsafeFreeze #-} \
160 ; {-# INLINE basicLength #-} \
161 ; {-# INLINE basicUnsafeSlice #-} \
162 ; {-# INLINE basicUnsafeIndexM #-} \
163 ; {-# INLINE elemseq #-} \
164 ; unsafeFreeze (mcon v) = con `liftM` G.unsafeFreeze v \
165 ; basicLength (con v) = G.basicLength v \
166 ; basicUnsafeSlice i n (con v) = con $ G.basicUnsafeSlice i n v \
167 ; basicUnsafeIndexM (con v) i = G.basicUnsafeIndexM v i \
168 ; basicUnsafeCopy (mcon mv) (con v) = G.basicUnsafeCopy mv v \
169 ; elemseq _ = seq }
170
171 newtype instance MVector s Int = MV_Int (P.MVector s Int)
172 newtype instance Vector Int = V_Int (P.Vector Int)
173 instance Unbox Int
174 primMVector(Int, MV_Int)
175 primVector(Int, V_Int, MV_Int)
176
177 newtype instance MVector s Int8 = MV_Int8 (P.MVector s Int8)
178 newtype instance Vector Int8 = V_Int8 (P.Vector Int8)
179 instance Unbox Int8
180 primMVector(Int8, MV_Int8)
181 primVector(Int8, V_Int8, MV_Int8)
182
183 newtype instance MVector s Int16 = MV_Int16 (P.MVector s Int16)
184 newtype instance Vector Int16 = V_Int16 (P.Vector Int16)
185 instance Unbox Int16
186 primMVector(Int16, MV_Int16)
187 primVector(Int16, V_Int16, MV_Int16)
188
189 newtype instance MVector s Int32 = MV_Int32 (P.MVector s Int32)
190 newtype instance Vector Int32 = V_Int32 (P.Vector Int32)
191 instance Unbox Int32
192 primMVector(Int32, MV_Int32)
193 primVector(Int32, V_Int32, MV_Int32)
194
195 newtype instance MVector s Int64 = MV_Int64 (P.MVector s Int64)
196 newtype instance Vector Int64 = V_Int64 (P.Vector Int64)
197 instance Unbox Int64
198 primMVector(Int64, MV_Int64)
199 primVector(Int64, V_Int64, MV_Int64)
200
201
202 newtype instance MVector s Word = MV_Word (P.MVector s Word)
203 newtype instance Vector Word = V_Word (P.Vector Word)
204 instance Unbox Word
205 primMVector(Word, MV_Word)
206 primVector(Word, V_Word, MV_Word)
207
208 newtype instance MVector s Word8 = MV_Word8 (P.MVector s Word8)
209 newtype instance Vector Word8 = V_Word8 (P.Vector Word8)
210 instance Unbox Word8
211 primMVector(Word8, MV_Word8)
212 primVector(Word8, V_Word8, MV_Word8)
213
214 newtype instance MVector s Word16 = MV_Word16 (P.MVector s Word16)
215 newtype instance Vector Word16 = V_Word16 (P.Vector Word16)
216 instance Unbox Word16
217 primMVector(Word16, MV_Word16)
218 primVector(Word16, V_Word16, MV_Word16)
219
220 newtype instance MVector s Word32 = MV_Word32 (P.MVector s Word32)
221 newtype instance Vector Word32 = V_Word32 (P.Vector Word32)
222 instance Unbox Word32
223 primMVector(Word32, MV_Word32)
224 primVector(Word32, V_Word32, MV_Word32)
225
226 newtype instance MVector s Word64 = MV_Word64 (P.MVector s Word64)
227 newtype instance Vector Word64 = V_Word64 (P.Vector Word64)
228 instance Unbox Word64
229 primMVector(Word64, MV_Word64)
230 primVector(Word64, V_Word64, MV_Word64)
231
232
233 newtype instance MVector s Float = MV_Float (P.MVector s Float)
234 newtype instance Vector Float = V_Float (P.Vector Float)
235 instance Unbox Float
236 primMVector(Float, MV_Float)
237 primVector(Float, V_Float, MV_Float)
238
239 newtype instance MVector s Double = MV_Double (P.MVector s Double)
240 newtype instance Vector Double = V_Double (P.Vector Double)
241 instance Unbox Double
242 primMVector(Double, MV_Double)
243 primVector(Double, V_Double, MV_Double)
244
245
246 newtype instance MVector s Char = MV_Char (P.MVector s Char)
247 newtype instance Vector Char = V_Char (P.Vector Char)
248 instance Unbox Char
249 primMVector(Char, MV_Char)
250 primVector(Char, V_Char, MV_Char)
251
252 -- ----
253 -- Bool
254 -- ----
255
256 fromBool :: Bool -> Word8
257 {-# INLINE fromBool #-}
258 fromBool True = 1
259 fromBool False = 0
260
261 toBool :: Word8 -> Bool
262 {-# INLINE toBool #-}
263 toBool 0 = False
264 toBool _ = True
265
266 newtype instance MVector s Bool = MV_Bool (P.MVector s Word8)
267 newtype instance Vector Bool = V_Bool (P.Vector Word8)
268
269 instance Unbox Bool
270
271 instance M.MVector MVector Bool where
272 {-# INLINE basicLength #-}
273 {-# INLINE basicUnsafeSlice #-}
274 {-# INLINE basicOverlaps #-}
275 {-# INLINE basicUnsafeNew #-}
276 {-# INLINE basicUnsafeReplicate #-}
277 {-# INLINE basicUnsafeRead #-}
278 {-# INLINE basicUnsafeWrite #-}
279 {-# INLINE basicClear #-}
280 {-# INLINE basicSet #-}
281 {-# INLINE basicUnsafeCopy #-}
282 {-# INLINE basicUnsafeGrow #-}
283 basicLength (MV_Bool v) = M.basicLength v
284 basicUnsafeSlice i n (MV_Bool v) = MV_Bool $ M.basicUnsafeSlice i n v
285 basicOverlaps (MV_Bool v1) (MV_Bool v2) = M.basicOverlaps v1 v2
286 basicUnsafeNew n = MV_Bool `liftM` M.basicUnsafeNew n
287 basicUnsafeReplicate n x = MV_Bool `liftM` M.basicUnsafeReplicate n (fromBool x)
288 basicUnsafeRead (MV_Bool v) i = toBool `liftM` M.basicUnsafeRead v i
289 basicUnsafeWrite (MV_Bool v) i x = M.basicUnsafeWrite v i (fromBool x)
290 basicClear (MV_Bool v) = M.basicClear v
291 basicSet (MV_Bool v) x = M.basicSet v (fromBool x)
292 basicUnsafeCopy (MV_Bool v1) (MV_Bool v2) = M.basicUnsafeCopy v1 v2
293 basicUnsafeGrow (MV_Bool v) n = MV_Bool `liftM` M.basicUnsafeGrow v n
294
295 instance G.Vector Vector Bool where
296 {-# INLINE unsafeFreeze #-}
297 {-# INLINE basicLength #-}
298 {-# INLINE basicUnsafeSlice #-}
299 {-# INLINE basicUnsafeIndexM #-}
300 {-# INLINE elemseq #-}
301 unsafeFreeze (MV_Bool v) = V_Bool `liftM` G.unsafeFreeze v
302 basicLength (V_Bool v) = G.basicLength v
303 basicUnsafeSlice i n (V_Bool v) = V_Bool $ G.basicUnsafeSlice i n v
304 basicUnsafeIndexM (V_Bool v) i = toBool `liftM` G.basicUnsafeIndexM v i
305 basicUnsafeCopy (MV_Bool mv) (V_Bool v) = G.basicUnsafeCopy mv v
306 elemseq _ = seq
307
308 -- -------
309 -- Complex
310 -- -------
311
312 newtype instance MVector s (Complex a) = MV_Complex (MVector s (a,a))
313 newtype instance Vector (Complex a) = V_Complex (Vector (a,a))
314
315 instance (RealFloat a, Unbox a) => Unbox (Complex a)
316
317 instance (RealFloat a, Unbox a) => M.MVector MVector (Complex a) where
318 {-# INLINE basicLength #-}
319 {-# INLINE basicUnsafeSlice #-}
320 {-# INLINE basicOverlaps #-}
321 {-# INLINE basicUnsafeNew #-}
322 {-# INLINE basicUnsafeReplicate #-}
323 {-# INLINE basicUnsafeRead #-}
324 {-# INLINE basicUnsafeWrite #-}
325 {-# INLINE basicClear #-}
326 {-# INLINE basicSet #-}
327 {-# INLINE basicUnsafeCopy #-}
328 {-# INLINE basicUnsafeGrow #-}
329 basicLength (MV_Complex v) = M.basicLength v
330 basicUnsafeSlice i n (MV_Complex v) = MV_Complex $ M.basicUnsafeSlice i n v
331 basicOverlaps (MV_Complex v1) (MV_Complex v2) = M.basicOverlaps v1 v2
332 basicUnsafeNew n = MV_Complex `liftM` M.basicUnsafeNew n
333 basicUnsafeReplicate n (x :+ y) = MV_Complex `liftM` M.basicUnsafeReplicate n (x,y)
334 basicUnsafeRead (MV_Complex v) i = uncurry (:+) `liftM` M.basicUnsafeRead v i
335 basicUnsafeWrite (MV_Complex v) i (x :+ y) = M.basicUnsafeWrite v i (x,y)
336 basicClear (MV_Complex v) = M.basicClear v
337 basicSet (MV_Complex v) (x :+ y) = M.basicSet v (x,y)
338 basicUnsafeCopy (MV_Complex v1) (MV_Complex v2) = M.basicUnsafeCopy v1 v2
339 basicUnsafeGrow (MV_Complex v) n = MV_Complex `liftM` M.basicUnsafeGrow v n
340
341 instance (RealFloat a, Unbox a) => G.Vector Vector (Complex a) where
342 {-# INLINE unsafeFreeze #-}
343 {-# INLINE basicLength #-}
344 {-# INLINE basicUnsafeSlice #-}
345 {-# INLINE basicUnsafeIndexM #-}
346 {-# INLINE elemseq #-}
347 unsafeFreeze (MV_Complex v) = V_Complex `liftM` G.unsafeFreeze v
348 basicLength (V_Complex v) = G.basicLength v
349 basicUnsafeSlice i n (V_Complex v) = V_Complex $ G.basicUnsafeSlice i n v
350 basicUnsafeIndexM (V_Complex v) i
351 = uncurry (:+) `liftM` G.basicUnsafeIndexM v i
352 basicUnsafeCopy (MV_Complex mv) (V_Complex v)
353 = G.basicUnsafeCopy mv v
354 elemseq _ (x :+ y) z = G.elemseq (undefined :: Vector a) x
355 $ G.elemseq (undefined :: Vector a) y z
356
357 -- ------
358 -- Tuples
359 -- ------
360
361 #define DEFINE_INSTANCES
362 #include "unbox-tuple-instances"
363