Generate Unbox instances for tuples
[darcs-mirrors/vector.git] / Data / Vector / Unboxed / Unbox.hs
1 {-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}
2 module Data.Vector.Unboxed.Unbox (
3 MVector(..), Vector(..), Unbox
4 ) where
5
6 import qualified Data.Vector.Generic as G
7 import qualified Data.Vector.Generic.Mutable as M
8
9 import qualified Data.Vector.Primitive as P
10
11 import Control.Monad.ST ( runST )
12 import Control.Monad
13
14 import Data.Word ( Word, Word8, Word16, Word32, Word64 )
15 import Data.Int ( Int8, Int16, Int32, Int64 )
16
17 #include "vector.h"
18
19 data family MVector s a
20 data family Vector a
21
22 type instance G.Mutable Vector = MVector
23
24 class (G.Vector Vector a, M.MVector MVector a) => Unbox a
25
26 -- ----
27 -- Unit
28 -- ----
29
30 newtype instance MVector s () = MV_Unit Int
31 newtype instance Vector () = V_Unit Int
32
33 instance Unbox ()
34
35 instance M.MVector MVector () where
36 {-# INLINE length #-}
37 {-# INLINE unsafeSlice #-}
38 {-# INLINE overlaps #-}
39 {-# INLINE unsafeNew #-}
40 {-# INLINE unsafeRead #-}
41 {-# INLINE unsafeWrite #-}
42 {-# INLINE clear #-}
43 {-# INLINE set #-}
44 {-# INLINE unsafeCopy #-}
45 {-# INLINE unsafeGrow #-}
46
47 length (MV_Unit n) = n
48
49 unsafeSlice (MV_Unit n) i m
50 = UNSAFE_CHECK(checkSlice) "unsafeSlice" i m n
51 $ MV_Unit m
52
53 overlaps _ _ = False
54
55 unsafeNew n = UNSAFE_CHECK(checkLength) "unsafeNew" n
56 $ return (MV_Unit n)
57
58 unsafeRead (MV_Unit n) i = UNSAFE_CHECK(checkIndex) "unsafeRead" i n
59 $ return ()
60
61 unsafeWrite (MV_Unit n) i () = UNSAFE_CHECK(checkIndex) "unsafeWrite" i n
62 $ return ()
63
64 clear _ = return ()
65
66 set (MV_Unit _) () = return ()
67
68 unsafeCopy (MV_Unit _) (MV_Unit _) = return ()
69
70 unsafeGrow (MV_Unit n) k = return $ MV_Unit (n+k)
71
72 instance G.Vector Vector () where
73 {-# INLINE unsafeFreeze #-}
74 unsafeFreeze (MV_Unit n) = return $ V_Unit n
75
76 {-# INLINE basicLength #-}
77 basicLength (V_Unit n) = n
78
79 {-# INLINE basicUnsafeSlice #-}
80 basicUnsafeSlice (V_Unit n) i m = V_Unit m
81
82 {-# INLINE basicUnsafeIndexM #-}
83 basicUnsafeIndexM (V_Unit _) i = return ()
84
85
86 -- ---------------
87 -- Primitive types
88 -- ---------------
89
90 #define primMVector(ty,con) \
91 instance M.MVector MVector ty where { \
92 {-# INLINE length #-} \
93 ; {-# INLINE unsafeSlice #-} \
94 ; {-# INLINE overlaps #-} \
95 ; {-# INLINE unsafeNew #-} \
96 ; {-# INLINE unsafeNewWith #-} \
97 ; {-# INLINE unsafeRead #-} \
98 ; {-# INLINE unsafeWrite #-} \
99 ; {-# INLINE clear #-} \
100 ; {-# INLINE set #-} \
101 ; {-# INLINE unsafeCopy #-} \
102 ; {-# INLINE unsafeGrow #-} \
103 ; length (con v) = M.length v \
104 ; unsafeSlice (con v) i n = con $ M.unsafeSlice v i n \
105 ; overlaps (con v1) (con v2) = M.overlaps v1 v2 \
106 ; unsafeNew n = con `liftM` M.unsafeNew n \
107 ; unsafeNewWith n x = con `liftM` M.unsafeNewWith n x \
108 ; unsafeRead (con v) i = M.unsafeRead v i \
109 ; unsafeWrite (con v) i x = M.unsafeWrite v i x \
110 ; clear (con v) = M.clear v \
111 ; set (con v) x = M.set v x \
112 ; unsafeCopy (con v1) (con v2) = M.unsafeCopy v1 v2 \
113 ; unsafeGrow (con v) n = con `liftM` M.unsafeGrow v n }
114
115 #define primVector(ty,con,mcon) \
116 instance G.Vector Vector ty where { \
117 {-# INLINE unsafeFreeze #-} \
118 ; {-# INLINE basicLength #-} \
119 ; {-# INLINE basicUnsafeSlice #-} \
120 ; {-# INLINE basicUnsafeIndexM #-} \
121 ; unsafeFreeze (mcon v) = con `liftM` G.unsafeFreeze v \
122 ; basicLength (con v) = G.basicLength v \
123 ; basicUnsafeSlice (con v) i n = con $ G.basicUnsafeSlice v i n \
124 ; basicUnsafeIndexM (con v) i = G.basicUnsafeIndexM v i }
125
126 newtype instance MVector s Int = MV_Int (P.MVector s Int)
127 newtype instance Vector Int = V_Int (P.Vector Int)
128 instance Unbox Int
129 primMVector(Int, MV_Int)
130 primVector(Int, V_Int, MV_Int)
131
132 newtype instance MVector s Int8 = MV_Int8 (P.MVector s Int8)
133 newtype instance Vector Int8 = V_Int8 (P.Vector Int8)
134 instance Unbox Int8
135 primMVector(Int8, MV_Int8)
136 primVector(Int8, V_Int8, MV_Int8)
137
138 newtype instance MVector s Int16 = MV_Int16 (P.MVector s Int16)
139 newtype instance Vector Int16 = V_Int16 (P.Vector Int16)
140 instance Unbox Int16
141 primMVector(Int16, MV_Int16)
142 primVector(Int16, V_Int16, MV_Int16)
143
144 newtype instance MVector s Int32 = MV_Int32 (P.MVector s Int32)
145 newtype instance Vector Int32 = V_Int32 (P.Vector Int32)
146 instance Unbox Int32
147 primMVector(Int32, MV_Int32)
148 primVector(Int32, V_Int32, MV_Int32)
149
150 newtype instance MVector s Int64 = MV_Int64 (P.MVector s Int64)
151 newtype instance Vector Int64 = V_Int64 (P.Vector Int64)
152 instance Unbox Int64
153 primMVector(Int64, MV_Int64)
154 primVector(Int64, V_Int64, MV_Int64)
155
156
157 newtype instance MVector s Word = MV_Word (P.MVector s Word)
158 newtype instance Vector Word = V_Word (P.Vector Word)
159 instance Unbox Word
160 primMVector(Word, MV_Word)
161 primVector(Word, V_Word, MV_Word)
162
163 newtype instance MVector s Word8 = MV_Word8 (P.MVector s Word8)
164 newtype instance Vector Word8 = V_Word8 (P.Vector Word8)
165 instance Unbox Word8
166 primMVector(Word8, MV_Word8)
167 primVector(Word8, V_Word8, MV_Word8)
168
169 newtype instance MVector s Word16 = MV_Word16 (P.MVector s Word16)
170 newtype instance Vector Word16 = V_Word16 (P.Vector Word16)
171 instance Unbox Word16
172 primMVector(Word16, MV_Word16)
173 primVector(Word16, V_Word16, MV_Word16)
174
175 newtype instance MVector s Word32 = MV_Word32 (P.MVector s Word32)
176 newtype instance Vector Word32 = V_Word32 (P.Vector Word32)
177 instance Unbox Word32
178 primMVector(Word32, MV_Word32)
179 primVector(Word32, V_Word32, MV_Word32)
180
181 newtype instance MVector s Word64 = MV_Word64 (P.MVector s Word64)
182 newtype instance Vector Word64 = V_Word64 (P.Vector Word64)
183 instance Unbox Word64
184 primMVector(Word64, MV_Word64)
185 primVector(Word64, V_Word64, MV_Word64)
186
187
188 newtype instance MVector s Float = MV_Float (P.MVector s Float)
189 newtype instance Vector Float = V_Float (P.Vector Float)
190 instance Unbox Float
191 primMVector(Float, MV_Float)
192 primVector(Float, V_Float, MV_Float)
193
194 newtype instance MVector s Double = MV_Double (P.MVector s Double)
195 newtype instance Vector Double = V_Double (P.Vector Double)
196 instance Unbox Double
197 primMVector(Double, MV_Double)
198 primVector(Double, V_Double, MV_Double)
199
200
201 newtype instance MVector s Char = MV_Char (P.MVector s Char)
202 newtype instance Vector Char = V_Char (P.Vector Char)
203 instance Unbox Char
204 primMVector(Char, MV_Char)
205 primVector(Char, V_Char, MV_Char)
206
207 -- ----
208 -- Bool
209 -- ----
210
211 fromBool :: Bool -> Word8
212 {-# INLINE fromBool #-}
213 fromBool True = 1
214 fromBool False = 0
215
216 toBool :: Word8 -> Bool
217 {-# INLINE toBool #-}
218 toBool 0 = False
219 toBool _ = True
220
221 newtype instance MVector s Bool = MV_Bool (P.MVector s Word8)
222 newtype instance Vector Bool = V_Bool (P.Vector Word8)
223
224 instance Unbox Bool
225
226 instance M.MVector MVector Bool where
227 {-# INLINE length #-}
228 {-# INLINE unsafeSlice #-}
229 {-# INLINE overlaps #-}
230 {-# INLINE unsafeNew #-}
231 {-# INLINE unsafeNewWith #-}
232 {-# INLINE unsafeRead #-}
233 {-# INLINE unsafeWrite #-}
234 {-# INLINE clear #-}
235 {-# INLINE set #-}
236 {-# INLINE unsafeCopy #-}
237 {-# INLINE unsafeGrow #-}
238 length (MV_Bool v) = M.length v
239 unsafeSlice (MV_Bool v) i n = MV_Bool $ M.unsafeSlice v i n
240 overlaps (MV_Bool v1) (MV_Bool v2) = M.overlaps v1 v2
241 unsafeNew n = MV_Bool `liftM` M.unsafeNew n
242 unsafeNewWith n x = MV_Bool `liftM` M.unsafeNewWith n (fromBool x)
243 unsafeRead (MV_Bool v) i = toBool `liftM` M.unsafeRead v i
244 unsafeWrite (MV_Bool v) i x = M.unsafeWrite v i (fromBool x)
245 clear (MV_Bool v) = M.clear v
246 set (MV_Bool v) x = M.set v (fromBool x)
247 unsafeCopy (MV_Bool v1) (MV_Bool v2) = M.unsafeCopy v1 v2
248 unsafeGrow (MV_Bool v) n = MV_Bool `liftM` M.unsafeGrow v n
249
250 instance G.Vector Vector Bool where
251 {-# INLINE unsafeFreeze #-}
252 {-# INLINE basicLength #-}
253 {-# INLINE basicUnsafeSlice #-}
254 {-# INLINE basicUnsafeIndexM #-}
255 unsafeFreeze (MV_Bool v) = V_Bool `liftM` G.unsafeFreeze v
256 basicLength (V_Bool v) = G.basicLength v
257 basicUnsafeSlice (V_Bool v) i n = V_Bool $ G.basicUnsafeSlice v i n
258 basicUnsafeIndexM (V_Bool v) i = toBool `liftM` G.basicUnsafeIndexM v i
259
260 -- ------
261 -- Tuples
262 -- ------
263
264 #include "unbox-tuple-instances"
265