1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
{-# LANGUAGE CPP, MultiParamTypeClasses, BangPatterns, TypeFamilies #-}
-- |
-- Module : Data.Vector.Generic.Mutable.Base
-- Copyright : (c) Roman Leshchinskiy 2008-2011
-- License : BSD-style
--
-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>
-- Stability : experimental
-- Portability : non-portable
--
-- Class of mutable vectors
--
module Data.Vector.Generic.Mutable.Base (
MVector(..)
) where
import Control.Monad.Primitive ( PrimMonad, PrimState )
-- Data.Vector.Internal.Check is unused
#define NOT_VECTOR_MODULE
#include "vector.h"
-- | Class of mutable vectors parametrised with a primitive state token.
--
class MVector v a where
-- | Length of the mutable vector. This method should not be
-- called directly, use 'length' instead.
basicLength :: v s a -> Int
-- | Yield a part of the mutable vector without copying it. This method
-- should not be called directly, use 'unsafeSlice' instead.
basicUnsafeSlice :: Int -- ^ starting index
-> Int -- ^ length of the slice
-> v s a
-> v s a
-- | Check whether two vectors overlap. This method should not be
-- called directly, use 'overlaps' instead.
basicOverlaps :: v s a -> v s a -> Bool
-- | Create a mutable vector of the given length. This method should not be
-- called directly, use 'unsafeNew' instead.
basicUnsafeNew :: PrimMonad m => Int -> m (v (PrimState m) a)
-- | Initialize a vector to a standard value. This is intended to be called as
-- part of the safe new operation (and similar operations), to properly blank
-- the newly allocated memory if necessary.
--
-- Vectors that are necessarily initialized as part of creation may implement
-- this as a no-op.
basicInitialize :: PrimMonad m => v (PrimState m) a -> m ()
-- | Create a mutable vector of the given length and fill it with an
-- initial value. This method should not be called directly, use
-- 'replicate' instead.
basicUnsafeReplicate :: PrimMonad m => Int -> a -> m (v (PrimState m) a)
-- | Yield the element at the given position. This method should not be
-- called directly, use 'unsafeRead' instead.
basicUnsafeRead :: PrimMonad m => v (PrimState m) a -> Int -> m a
-- | Replace the element at the given position. This method should not be
-- called directly, use 'unsafeWrite' instead.
basicUnsafeWrite :: PrimMonad m => v (PrimState m) a -> Int -> a -> m ()
-- | Reset all elements of the vector to some undefined value, clearing all
-- references to external objects. This is usually a noop for unboxed
-- vectors. This method should not be called directly, use 'clear' instead.
basicClear :: PrimMonad m => v (PrimState m) a -> m ()
-- | Set all elements of the vector to the given value. This method should
-- not be called directly, use 'set' instead.
basicSet :: PrimMonad m => v (PrimState m) a -> a -> m ()
-- | Copy a vector. The two vectors may not overlap. This method should not
-- be called directly, use 'unsafeCopy' instead.
basicUnsafeCopy :: PrimMonad m => v (PrimState m) a -- ^ target
-> v (PrimState m) a -- ^ source
-> m ()
-- | Move the contents of a vector. The two vectors may overlap. This method
-- should not be called directly, use 'unsafeMove' instead.
basicUnsafeMove :: PrimMonad m => v (PrimState m) a -- ^ target
-> v (PrimState m) a -- ^ source
-> m ()
-- | Grow a vector by the given number of elements. This method should not be
-- called directly, use 'unsafeGrow' instead.
basicUnsafeGrow :: PrimMonad m => v (PrimState m) a -> Int
-> m (v (PrimState m) a)
{-# INLINE basicUnsafeReplicate #-}
basicUnsafeReplicate n x
= do
v <- basicUnsafeNew n
basicSet v x
return v
{-# INLINE basicClear #-}
basicClear _ = return ()
{-# INLINE basicSet #-}
basicSet !v x
| n == 0 = return ()
| otherwise = do
basicUnsafeWrite v 0 x
do_set 1
where
!n = basicLength v
do_set i | 2*i < n = do basicUnsafeCopy (basicUnsafeSlice i i v)
(basicUnsafeSlice 0 i v)
do_set (2*i)
| otherwise = basicUnsafeCopy (basicUnsafeSlice i (n-i) v)
(basicUnsafeSlice 0 (n-i) v)
{-# INLINE basicUnsafeCopy #-}
basicUnsafeCopy !dst !src = do_copy 0
where
!n = basicLength src
do_copy i | i < n = do
x <- basicUnsafeRead src i
basicUnsafeWrite dst i x
do_copy (i+1)
| otherwise = return ()
{-# INLINE basicUnsafeMove #-}
basicUnsafeMove !dst !src
| basicOverlaps dst src = do
srcCopy <- basicUnsafeNew (basicLength src)
basicUnsafeCopy srcCopy src
basicUnsafeCopy dst srcCopy
| otherwise = basicUnsafeCopy dst src
{-# INLINE basicUnsafeGrow #-}
basicUnsafeGrow v by
= do
v' <- basicUnsafeNew (n+by)
basicUnsafeCopy (basicUnsafeSlice 0 n v') v
return v'
where
n = basicLength v
|
