52270223d7e30efcfa1319e53b90efb4897f5f2f
[darcs-mirrors/vector.git] / Data / Vector / Storable / Mutable.hs
1 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-}
2
3 -- |
4 -- Module : Data.Vector.Storable.Mutable
5 -- Copyright : (c) Roman Leshchinskiy 2009-2010
6 -- License : BSD-style
7 --
8 -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>
9 -- Stability : experimental
10 -- Portability : non-portable
11 --
12 -- Mutable vectors based on Storable.
13 --
14
15 module Data.Vector.Storable.Mutable(
16 -- * Mutable vectors of 'Storable' types
17 MVector(..), IOVector, STVector, Storable,
18
19 -- * Accessors
20
21 -- ** Length information
22 length, null,
23
24 -- ** Extracting subvectors
25 slice, init, tail, take, drop, splitAt,
26 unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop,
27
28 -- ** Overlapping
29 overlaps,
30
31 -- * Construction
32
33 -- ** Initialisation
34 new, unsafeNew, replicate, replicateM, clone,
35
36 -- ** Growing
37 grow, unsafeGrow,
38
39 -- ** Restricting memory usage
40 clear,
41
42 -- * Accessing individual elements
43 read, write, swap,
44 unsafeRead, unsafeWrite, unsafeSwap,
45
46 -- * Modifying vectors
47
48 -- ** Filling and copying
49 set, copy, move, unsafeCopy, unsafeMove,
50
51 -- * Unsafe conversions
52 unsafeCast,
53
54 -- * Raw pointers
55 unsafeFromForeignPtr, unsafeToForeignPtr, unsafeWith
56 ) where
57
58 import qualified Data.Vector.Generic.Mutable as G
59 import Data.Vector.Storable.Internal
60
61 import Foreign.Storable
62 import Foreign.ForeignPtr
63
64 #if __GLASGOW_HASKELL__ >= 605
65 import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
66 #endif
67
68 import Foreign.Ptr
69 import Foreign.Marshal.Array ( advancePtr, copyArray, moveArray )
70 import Foreign.C.Types ( CInt )
71
72 import Control.Monad.Primitive
73
74 import Prelude hiding ( length, null, replicate, reverse, map, read,
75 take, drop, splitAt, init, tail )
76
77 import Data.Typeable ( Typeable )
78
79 #include "vector.h"
80
81 -- | Mutable 'Storable'-based vectors
82 data MVector s a = MVector {-# UNPACK #-} !Int
83 {-# UNPACK #-} !(ForeignPtr a)
84 deriving ( Typeable )
85
86 type IOVector = MVector RealWorld
87 type STVector s = MVector s
88
89 instance Storable a => G.MVector MVector a where
90 {-# INLINE basicLength #-}
91 basicLength (MVector n _) = n
92
93 {-# INLINE basicUnsafeSlice #-}
94 basicUnsafeSlice j m (MVector n fp) = MVector m (updPtr (`advancePtr` j) fp)
95
96 -- FIXME: this relies on non-portable pointer comparisons
97 {-# INLINE basicOverlaps #-}
98 basicOverlaps (MVector m fp) (MVector n fq)
99 = between p q (q `advancePtr` n) || between q p (p `advancePtr` m)
100 where
101 between x y z = x >= y && x < z
102 p = getPtr fp
103 q = getPtr fq
104
105 {-# INLINE basicUnsafeNew #-}
106 basicUnsafeNew n
107 = unsafePrimToPrim
108 $ do
109 fp <- mallocVector n
110 return $ MVector n fp
111
112 {-# INLINE basicUnsafeRead #-}
113 basicUnsafeRead (MVector _ fp) i
114 = unsafePrimToPrim
115 $ withForeignPtr fp (`peekElemOff` i)
116
117 {-# INLINE basicUnsafeWrite #-}
118 basicUnsafeWrite (MVector _ fp) i x
119 = unsafePrimToPrim
120 $ withForeignPtr fp $ \p -> pokeElemOff p i x
121
122 {-# INLINE basicUnsafeCopy #-}
123 basicUnsafeCopy (MVector n fp) (MVector _ fq)
124 = unsafePrimToPrim
125 $ withForeignPtr fp $ \p ->
126 withForeignPtr fq $ \q ->
127 copyArray p q n
128
129 {-# INLINE basicUnsafeMove #-}
130 basicUnsafeMove (MVector n fp) (MVector _ fq)
131 = unsafePrimToPrim
132 $ withForeignPtr fp $ \p ->
133 withForeignPtr fq $ \q ->
134 moveArray p q n
135
136 {-# INLINE mallocVector #-}
137 mallocVector :: Storable a => Int -> IO (ForeignPtr a)
138 mallocVector =
139 #if __GLASGOW_HASKELL__ >= 605
140 doMalloc undefined
141 where
142 doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b)
143 doMalloc dummy size = mallocPlainForeignPtrBytes (size * sizeOf dummy)
144 #else
145 mallocForeignPtrArray
146 #endif
147
148 -- Length information
149 -- ------------------
150
151 -- | Length of the mutable vector.
152 length :: Storable a => MVector s a -> Int
153 {-# INLINE length #-}
154 length = G.length
155
156 -- | Check whether the vector is empty
157 null :: Storable a => MVector s a -> Bool
158 {-# INLINE null #-}
159 null = G.null
160
161 -- Extracting subvectors
162 -- ---------------------
163
164 -- | Yield a part of the mutable vector without copying it.
165 slice :: Storable a => Int -> Int -> MVector s a -> MVector s a
166 {-# INLINE slice #-}
167 slice = G.slice
168
169 take :: Storable a => Int -> MVector s a -> MVector s a
170 {-# INLINE take #-}
171 take = G.take
172
173 drop :: Storable a => Int -> MVector s a -> MVector s a
174 {-# INLINE drop #-}
175 drop = G.drop
176
177 splitAt :: Storable a => Int -> MVector s a -> (MVector s a, MVector s a)
178 {-# INLINE splitAt #-}
179 splitAt = G.splitAt
180
181 init :: Storable a => MVector s a -> MVector s a
182 {-# INLINE init #-}
183 init = G.init
184
185 tail :: Storable a => MVector s a -> MVector s a
186 {-# INLINE tail #-}
187 tail = G.tail
188
189 -- | Yield a part of the mutable vector without copying it. No bounds checks
190 -- are performed.
191 unsafeSlice :: Storable a
192 => Int -- ^ starting index
193 -> Int -- ^ length of the slice
194 -> MVector s a
195 -> MVector s a
196 {-# INLINE unsafeSlice #-}
197 unsafeSlice = G.unsafeSlice
198
199 unsafeTake :: Storable a => Int -> MVector s a -> MVector s a
200 {-# INLINE unsafeTake #-}
201 unsafeTake = G.unsafeTake
202
203 unsafeDrop :: Storable a => Int -> MVector s a -> MVector s a
204 {-# INLINE unsafeDrop #-}
205 unsafeDrop = G.unsafeDrop
206
207 unsafeInit :: Storable a => MVector s a -> MVector s a
208 {-# INLINE unsafeInit #-}
209 unsafeInit = G.unsafeInit
210
211 unsafeTail :: Storable a => MVector s a -> MVector s a
212 {-# INLINE unsafeTail #-}
213 unsafeTail = G.unsafeTail
214
215 -- Overlapping
216 -- -----------
217
218 -- Check whether two vectors overlap.
219 overlaps :: Storable a => MVector s a -> MVector s a -> Bool
220 {-# INLINE overlaps #-}
221 overlaps = G.overlaps
222
223 -- Initialisation
224 -- --------------
225
226 -- | Create a mutable vector of the given length.
227 new :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a)
228 {-# INLINE new #-}
229 new = G.new
230
231 -- | Create a mutable vector of the given length. The length is not checked.
232 unsafeNew :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a)
233 {-# INLINE unsafeNew #-}
234 unsafeNew = G.unsafeNew
235
236 -- | Create a mutable vector of the given length (0 if the length is negative)
237 -- and fill it with an initial value.
238 replicate :: (PrimMonad m, Storable a) => Int -> a -> m (MVector (PrimState m) a)
239 {-# INLINE replicate #-}
240 replicate = G.replicate
241
242 -- | Create a mutable vector of the given length (0 if the length is negative)
243 -- and fill it with values produced by repeatedly executing the monadic action.
244 replicateM :: (PrimMonad m, Storable a) => Int -> m a -> m (MVector (PrimState m) a)
245 {-# INLINE replicateM #-}
246 replicateM = G.replicateM
247
248 -- | Create a copy of a mutable vector.
249 clone :: (PrimMonad m, Storable a)
250 => MVector (PrimState m) a -> m (MVector (PrimState m) a)
251 {-# INLINE clone #-}
252 clone = G.clone
253
254 -- Growing
255 -- -------
256
257 -- | Grow a vector by the given number of elements. The number must be
258 -- positive.
259 grow :: (PrimMonad m, Storable a)
260 => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
261 {-# INLINE grow #-}
262 grow = G.grow
263
264 -- | Grow a vector by the given number of elements. The number must be
265 -- positive but this is not checked.
266 unsafeGrow :: (PrimMonad m, Storable a)
267 => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
268 {-# INLINE unsafeGrow #-}
269 unsafeGrow = G.unsafeGrow
270
271 -- Restricting memory usage
272 -- ------------------------
273
274 -- | Reset all elements of the vector to some undefined value, clearing all
275 -- references to external objects. This is usually a noop for unboxed vectors.
276 clear :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> m ()
277 {-# INLINE clear #-}
278 clear = G.clear
279
280 -- Accessing individual elements
281 -- -----------------------------
282
283 -- | Yield the element at the given position.
284 read :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a
285 {-# INLINE read #-}
286 read = G.read
287
288 -- | Replace the element at the given position.
289 write
290 :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m ()
291 {-# INLINE write #-}
292 write = G.write
293
294 -- | Swap the elements at the given positions.
295 swap
296 :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> Int -> m ()
297 {-# INLINE swap #-}
298 swap = G.swap
299
300
301 -- | Yield the element at the given position. No bounds checks are performed.
302 unsafeRead :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a
303 {-# INLINE unsafeRead #-}
304 unsafeRead = G.unsafeRead
305
306 -- | Replace the element at the given position. No bounds checks are performed.
307 unsafeWrite
308 :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m ()
309 {-# INLINE unsafeWrite #-}
310 unsafeWrite = G.unsafeWrite
311
312 -- | Swap the elements at the given positions. No bounds checks are performed.
313 unsafeSwap
314 :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> Int -> m ()
315 {-# INLINE unsafeSwap #-}
316 unsafeSwap = G.unsafeSwap
317
318 -- Filling and copying
319 -- -------------------
320
321 -- | Set all elements of the vector to the given value.
322 set :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> a -> m ()
323 {-# INLINE set #-}
324 set = G.set
325
326 -- | Copy a vector. The two vectors must have the same length and may not
327 -- overlap.
328 copy :: (PrimMonad m, Storable a)
329 => MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
330 {-# INLINE copy #-}
331 copy = G.copy
332
333 -- | Copy a vector. The two vectors must have the same length and may not
334 -- overlap. This is not checked.
335 unsafeCopy :: (PrimMonad m, Storable a)
336 => MVector (PrimState m) a -- ^ target
337 -> MVector (PrimState m) a -- ^ source
338 -> m ()
339 {-# INLINE unsafeCopy #-}
340 unsafeCopy = G.unsafeCopy
341
342 -- | Move the contents of a vector. The two vectors must have the same
343 -- length.
344 --
345 -- If the vectors do not overlap, then this is equivalent to 'copy'.
346 -- Otherwise, the copying is performed as if the source vector were
347 -- copied to a temporary vector and then the temporary vector was copied
348 -- to the target vector.
349 move :: (PrimMonad m, Storable a)
350 => MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
351 {-# INLINE move #-}
352 move = G.move
353
354 -- | Move the contents of a vector. The two vectors must have the same
355 -- length, but this is not checked.
356 --
357 -- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'.
358 -- Otherwise, the copying is performed as if the source vector were
359 -- copied to a temporary vector and then the temporary vector was copied
360 -- to the target vector.
361 unsafeMove :: (PrimMonad m, Storable a)
362 => MVector (PrimState m) a -- ^ target
363 -> MVector (PrimState m) a -- ^ source
364 -> m ()
365 {-# INLINE unsafeMove #-}
366 unsafeMove = G.unsafeMove
367
368 -- Unsafe conversions
369 -- ------------------
370
371 -- | /O(1)/ Unsafely cast a mutable vector from one element type to another.
372 -- The operation just changes the type of the underlying pointer and does not
373 -- modify the elements.
374 --
375 -- The resulting vector contains as many elements as can fit into the
376 -- underlying memory block.
377 --
378 unsafeCast :: forall a b s.
379 (Storable a, Storable b) => MVector s a -> MVector s b
380 {-# INLINE unsafeCast #-}
381 unsafeCast (MVector n fp)
382 = MVector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b))
383 (castForeignPtr fp)
384
385 -- Raw pointers
386 -- ------------
387
388 -- | Create a mutable vector from a 'ForeignPtr' with an offset and a length.
389 -- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector
390 -- could have been frozen before the modification.
391 unsafeFromForeignPtr :: Storable a
392 => ForeignPtr a -- ^ pointer
393 -> Int -- ^ offset
394 -> Int -- ^ length
395 -> MVector s a
396 {-# INLINE unsafeFromForeignPtr #-}
397 unsafeFromForeignPtr fp i n = MVector n (updPtr (`advancePtr` i) fp)
398
399 -- | Yield the underlying 'ForeignPtr' together with the offset to the data
400 -- and its length. Modifying the data through the 'ForeignPtr' is
401 -- unsafe if the vector could have frozen before the modification.
402 unsafeToForeignPtr :: Storable a => MVector s a -> (ForeignPtr a, Int, Int)
403 {-# INLINE unsafeToForeignPtr #-}
404 unsafeToForeignPtr (MVector n fp) = (fp, 0, n)
405
406 -- | Pass a pointer to the vector's data to the IO action. Modifying data
407 -- through the pointer is unsafe if the vector could have been frozen before
408 -- the modification.
409 unsafeWith :: Storable a => IOVector a -> (Ptr a -> IO b) -> IO b
410 {-# INLINE unsafeWith #-}
411 unsafeWith (MVector n fp) = withForeignPtr fp
412