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