Clean up interface to mutable vectors
[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.Primitive
12 import Control.Monad.ST ( runST )
13 import Control.Monad ( liftM )
14
15 import Data.Word ( Word, Word8, Word16, Word32, Word64 )
16 import Data.Int ( Int8, Int16, Int32, Int64 )
17
18 #include "vector.h"
19
20 data family MVector s a
21 data family Vector a
22
23 type IOVector = MVector RealWorld
24 type STVector s = MVector s
25
26 type instance G.Mutable Vector = MVector
27
28 class (G.Vector Vector a, M.MVector MVector a) => Unbox a
29
30
31 -- ----
32 -- Unit
33 -- ----
34
35 newtype instance MVector s () = MV_Unit Int
36 newtype instance Vector () = V_Unit Int
37
38 instance Unbox ()
39
40 instance M.MVector MVector () where
41 {-# INLINE basicLength #-}
42 {-# INLINE basicUnsafeSlice #-}
43 {-# INLINE basicOverlaps #-}
44 {-# INLINE basicUnsafeNew #-}
45 {-# INLINE basicUnsafeRead #-}
46 {-# INLINE basicUnsafeWrite #-}
47 {-# INLINE basicClear #-}
48 {-# INLINE basicSet #-}
49 {-# INLINE basicUnsafeCopy #-}
50 {-# INLINE basicUnsafeGrow #-}
51
52 basicLength (MV_Unit n) = n
53
54 basicUnsafeSlice (MV_Unit n) i m = MV_Unit m
55
56 basicOverlaps _ _ = False
57
58 basicUnsafeNew n = return (MV_Unit n)
59
60 basicUnsafeRead (MV_Unit _) _ = return ()
61
62 basicUnsafeWrite (MV_Unit _) _ () = return ()
63
64 basicClear _ = return ()
65
66 basicSet (MV_Unit _) () = return ()
67
68 basicUnsafeCopy (MV_Unit _) (MV_Unit _) = return ()
69
70 basicUnsafeGrow (MV_Unit n) m = return $ MV_Unit (n+m)
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 basicLength #-} \
93 ; {-# INLINE basicUnsafeSlice #-} \
94 ; {-# INLINE basicOverlaps #-} \
95 ; {-# INLINE basicUnsafeNew #-} \
96 ; {-# INLINE basicUnsafeNewWith #-} \
97 ; {-# INLINE basicUnsafeRead #-} \
98 ; {-# INLINE basicUnsafeWrite #-} \
99 ; {-# INLINE basicClear #-} \
100 ; {-# INLINE basicSet #-} \
101 ; {-# INLINE basicUnsafeCopy #-} \
102 ; {-# INLINE basicUnsafeGrow #-} \
103 ; basicLength (con v) = M.basicLength v \
104 ; basicUnsafeSlice (con v) i n = con $ M.basicUnsafeSlice v i n \
105 ; basicOverlaps (con v1) (con v2) = M.basicOverlaps v1 v2 \
106 ; basicUnsafeNew n = con `liftM` M.basicUnsafeNew n \
107 ; basicUnsafeNewWith n x = con `liftM` M.basicUnsafeNewWith n x \
108 ; basicUnsafeRead (con v) i = M.basicUnsafeRead v i \
109 ; basicUnsafeWrite (con v) i x = M.basicUnsafeWrite v i x \
110 ; basicClear (con v) = M.basicClear v \
111 ; basicSet (con v) x = M.basicSet v x \
112 ; basicUnsafeCopy (con v1) (con v2) = M.basicUnsafeCopy v1 v2 \
113 ; basicUnsafeGrow (con v) n = con `liftM` M.basicUnsafeGrow 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 basicLength #-}
228 {-# INLINE basicUnsafeSlice #-}
229 {-# INLINE basicOverlaps #-}
230 {-# INLINE basicUnsafeNew #-}
231 {-# INLINE basicUnsafeNewWith #-}
232 {-# INLINE basicUnsafeRead #-}
233 {-# INLINE basicUnsafeWrite #-}
234 {-# INLINE basicClear #-}
235 {-# INLINE basicSet #-}
236 {-# INLINE basicUnsafeCopy #-}
237 {-# INLINE basicUnsafeGrow #-}
238 basicLength (MV_Bool v) = M.basicLength v
239 basicUnsafeSlice (MV_Bool v) i n = MV_Bool $ M.basicUnsafeSlice v i n
240 basicOverlaps (MV_Bool v1) (MV_Bool v2) = M.basicOverlaps v1 v2
241 basicUnsafeNew n = MV_Bool `liftM` M.basicUnsafeNew n
242 basicUnsafeNewWith n x = MV_Bool `liftM` M.basicUnsafeNewWith n (fromBool x)
243 basicUnsafeRead (MV_Bool v) i = toBool `liftM` M.basicUnsafeRead v i
244 basicUnsafeWrite (MV_Bool v) i x = M.basicUnsafeWrite v i (fromBool x)
245 basicClear (MV_Bool v) = M.basicClear v
246 basicSet (MV_Bool v) x = M.basicSet v (fromBool x)
247 basicUnsafeCopy (MV_Bool v1) (MV_Bool v2) = M.basicUnsafeCopy v1 v2
248 basicUnsafeGrow (MV_Bool v) n = MV_Bool `liftM` M.basicUnsafeGrow 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