From 69b09a918a8d87ae05cc6dd43cc2143b4fe1909c Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Mon, 18 Jan 2021 01:19:11 +0300 Subject: [PATCH] Improve haddock of `grow` functions and clarify their semantics. Fix #36 --- Data/Vector/Generic/Mutable.hs | 51 +++++++++++++++++++++++++---- Data/Vector/Generic/Mutable/Base.hs | 5 +-- Data/Vector/Mutable.hs | 42 +++++++++++++++++++++--- Data/Vector/Primitive/Mutable.hs | 42 +++++++++++++++++++++--- Data/Vector/Storable/Mutable.hs | 42 +++++++++++++++++++++--- Data/Vector/Unboxed/Mutable.hs | 42 +++++++++++++++++++++--- 6 files changed, 200 insertions(+), 24 deletions(-) diff --git a/Data/Vector/Generic/Mutable.hs b/Data/Vector/Generic/Mutable.hs index 8bfabf62..0ef3adb3 100644 --- a/Data/Vector/Generic/Mutable.hs +++ b/Data/Vector/Generic/Mutable.hs @@ -631,8 +631,18 @@ clone v = do -- Growing -- ------- --- | Grow a vector by the given number of elements. The number must be --- positive. +-- | Grow a vector by the given number of elements. The number must not be +-- negative otherwise error is thrown. Semantics of this function is exactly the +-- same as `unsafeGrow`, except that it will initialize the newly +-- allocated memory first. +-- +-- It is important to note that mutating the returned vector will not affect the +-- vector that was used as a source. In other words it does not, nor will it +-- ever have the semantics of @realloc@ from C. +-- +-- > grow mv 0 === clone mv +-- +-- @since 0.4.0 grow :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m (v (PrimState m) a) {-# INLINE grow #-} @@ -642,6 +652,10 @@ grow v by = BOUNDS_CHECK(checkLength) "grow" by basicInitialize $ basicUnsafeSlice (length v) by vnew return vnew +-- | Same as `grow`, except that it copies data towards the end of the newly +-- allocated vector making extra space available at the beginning. +-- +-- @since 0.11.0.0 growFront :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m (v (PrimState m) a) {-# INLINE growFront #-} @@ -675,15 +689,40 @@ enlargeFront v = stToPrim $ do where by = enlarge_delta v --- | Grow a vector by the given number of elements. The number must be --- positive but this is not checked. -unsafeGrow :: (PrimMonad m, MVector v a) - => v (PrimState m) a -> Int -> m (v (PrimState m) a) +-- | Grow a vector by allocating a new mutable vector of the same size plus the +-- the given number of elements and copying all the data over to the new vector +-- starting at its beginning. The newly allocated memory is not initialized and +-- the extra space at the end will likely contain garbage data or uninitialzed +-- error. Use `unsafeGrowFront` to make the extra space available in the front +-- of the new vector. +-- +-- It is important to note that mutating the returned vector will not affect +-- elements of the vector that was used as a source. In other words it does not, +-- nor will it ever have the semantics of @realloc@ from C. Keep in mind, +-- however, that values themselves can be of a mutable type +-- (eg. `Foreign.Ptr.Ptr`), in which case it would be possible to affect values +-- stored in both vectors. +-- +-- > unsafeGrow mv 0 === clone mv +-- +-- @since 0.4.0 +unsafeGrow :: + (PrimMonad m, MVector v a) + => v (PrimState m) a + -- ^ A mutable vector to copy the data from. + -> Int + -- ^ Number of elements to grow the vector by. It must be non-negative but + -- this is not checked. + -> m (v (PrimState m) a) {-# INLINE unsafeGrow #-} unsafeGrow v n = UNSAFE_CHECK(checkLength) "unsafeGrow" n $ stToPrim $ basicUnsafeGrow v n +-- | Same as `unsafeGrow`, except that it copies data towards the end of the +-- newly allocated vector making extra space available at the beginning. +-- +-- @since 0.11.0.0 unsafeGrowFront :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m (v (PrimState m) a) {-# INLINE unsafeGrowFront #-} diff --git a/Data/Vector/Generic/Mutable/Base.hs b/Data/Vector/Generic/Mutable/Base.hs index 09b87176..1d023ea4 100644 --- a/Data/Vector/Generic/Mutable/Base.hs +++ b/Data/Vector/Generic/Mutable/Base.hs @@ -87,8 +87,9 @@ class MVector v a where -> v s a -- ^ source -> ST s () - -- | Grow a vector by the given number of elements. This method should not be - -- called directly, use 'unsafeGrow' instead. + -- | Grow a vector by the given number of elements. Allocates a new vector and + -- copies all of the elements over starting at 0 index. This method should not + -- be called directly, use 'unsafeGrow' instead. basicUnsafeGrow :: v s a -> Int -> ST s (v s a) {-# INLINE basicUnsafeReplicate #-} diff --git a/Data/Vector/Mutable.hs b/Data/Vector/Mutable.hs index e8e4e3f7..5acd5362 100644 --- a/Data/Vector/Mutable.hs +++ b/Data/Vector/Mutable.hs @@ -309,15 +309,49 @@ clone = G.clone -- Growing -- ------- --- | Grow a vector by the given number of elements. The number must be --- positive. +-- | Grow a boxed vector by the given number of elements. The number must be +-- non-negative. Same semantics as in `G.grow` for generic vector. It differes +-- from @grow@ functions for unpacked vectors, however, in that only pointers to +-- values are copied over, therefore values themselves will be shared between +-- two vectors. This is an important distinction to know about during memory +-- usage analysis and in case when values themselves are of a mutable type, eg. +-- `Data.IORef.IORef` or another mutable vector. +-- +-- ====__Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> import qualified Data.Vector.Mutable as MV +-- >>> mv <- V.thaw $ V.fromList ([10, 20, 30] :: [Integer]) +-- >>> mv' <- MV.grow mv 2 +-- +-- The two extra elements at the end of the newly allocated vector will be +-- uninitialized and will result in an error if evaluated, so me must overwrite +-- them with new values first: +-- +-- >>> MV.write mv' 3 999 +-- >>> MV.write mv' 4 777 +-- >>> V.unsafeFreeze mv' +-- [10,20,30,999,777] +-- +-- It is important to note that the source mutable vector is not affected when +-- the newly allocated one is mutated. +-- +-- >>> MV.write mv' 2 888 +-- >>> V.unsafeFreeze mv' +-- [10,20,888,999,777] +-- >>> V.unsafeFreeze mv +-- [10,20,30] +-- +-- @since 0.5 grow :: PrimMonad m => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE grow #-} grow = G.grow --- | Grow a vector by the given number of elements. The number must be --- positive but this is not checked. +-- | Grow a vector by the given number of elements. The number must be non-negative but +-- this is not checked. Same semantics as in `G.unsafeGrow` for generic vector. +-- +-- @since 0.5 unsafeGrow :: PrimMonad m => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE unsafeGrow #-} diff --git a/Data/Vector/Primitive/Mutable.hs b/Data/Vector/Primitive/Mutable.hs index 3813bd51..3cce7185 100644 --- a/Data/Vector/Primitive/Mutable.hs +++ b/Data/Vector/Primitive/Mutable.hs @@ -276,15 +276,49 @@ clone = G.clone -- Growing -- ------- --- | Grow a vector by the given number of elements. The number must be --- positive. +-- | Grow a primitive vector by the given number of elements. The number must be +-- non-negative. Same semantics as in `G.grow` for generic vector. +-- +-- ====__Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> import qualified Data.Vector.Primitive.Mutable as MVP +-- >>> mv <- VP.thaw $ VP.fromList ([10, 20, 30] :: [Int]) +-- >>> mv' <- MVP.grow mv 2 +-- +-- Extra elements at the end of the newly allocated vector are initialized to +-- default value, which for primitive vector will always be 0. However, if +-- `unsafeGrow` was used instead this would not have been guaranteed and some +-- grabage would be there instead: +-- +-- >>> VP.unsafeFreeze mv' +-- [10,20,30,0,0] +-- +-- Having the extra space we can write new values in there: +-- +-- >>> MVP.write mv' 3 999 +-- >>> VP.unsafeFreeze mv' +-- [10,20,30,999,0] +-- +-- It is important to note that the source mutable vector is not affected when +-- the newly allocated one is mutated. +-- +-- >>> MVP.write mv' 2 888 +-- >>> VP.unsafeFreeze mv' +-- [10,20,888,999,0] +-- >>> VP.unsafeFreeze mv +-- [10,20,30] +-- +-- @since 0.5 grow :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE grow #-} grow = G.grow --- | Grow a vector by the given number of elements. The number must be --- positive but this is not checked. +-- | Grow a vector by the given number of elements. The number must be non-negative but +-- this is not checked. Same semantics as in `G.unsafeGrow` for generic vector. +-- +-- @since 0.5 unsafeGrow :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE unsafeGrow #-} diff --git a/Data/Vector/Storable/Mutable.hs b/Data/Vector/Storable/Mutable.hs index d034312e..e7824ed0 100644 --- a/Data/Vector/Storable/Mutable.hs +++ b/Data/Vector/Storable/Mutable.hs @@ -371,15 +371,49 @@ clone = G.clone -- Growing -- ------- --- | Grow a vector by the given number of elements. The number must be --- positive. +-- | Grow a storable vector by the given number of elements. The number must be +-- non-negative. Same semantics as in `G.grow` for generic vector. +-- +-- ====__Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> import qualified Data.Vector.Storable.Mutable as MVS +-- >>> mv <- VS.thaw $ VS.fromList ([10, 20, 30] :: [Int]) +-- >>> mv' <- MVS.grow mv 2 +-- +-- Extra elements at the end of the newly allocated vector are initialized to +-- default value, which for storable vector will always be 0. However, if +-- `unsafeGrow` was used instead this would not have been guaranteed and some +-- grabage would be there instead: +-- +-- >>> VS.unsafeFreeze mv' +-- [10,20,30,0,0] +-- +-- Having the extra space we can write new values in there: +-- +-- >>> MVS.write mv' 3 999 +-- >>> VS.unsafeFreeze mv' +-- [10,20,30,999,0] +-- +-- It is important to note that the source mutable vector is not affected when +-- the newly allocated one is mutated. +-- +-- >>> MVS.write mv' 2 888 +-- >>> VS.unsafeFreeze mv' +-- [10,20,888,999,0] +-- >>> VS.unsafeFreeze mv +-- [10,20,30] +-- +-- @since 0.5 grow :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE grow #-} grow = G.grow --- | Grow a vector by the given number of elements. The number must be --- positive but this is not checked. +-- | Grow a vector by the given number of elements. The number must be non-negative but +-- this is not checked. Same semantics as in `G.unsafeGrow` for generic vector. +-- +-- @since 0.5 unsafeGrow :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE unsafeGrow #-} diff --git a/Data/Vector/Unboxed/Mutable.hs b/Data/Vector/Unboxed/Mutable.hs index 828d5668..7469f7a5 100644 --- a/Data/Vector/Unboxed/Mutable.hs +++ b/Data/Vector/Unboxed/Mutable.hs @@ -187,15 +187,49 @@ clone = G.clone -- Growing -- ------- --- | Grow a vector by the given number of elements. The number must be --- positive. +-- | Grow an unboxed vector by the given number of elements. The number must be +-- non-negative. Same semantics as in `G.grow` for generic vector. +-- +-- ====__Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> import qualified Data.Vector.Unboxed.Mutable as MVU +-- >>> mv <- VU.thaw $ VU.fromList ([('a', 10), ('b', 20), ('c', 30)] :: [(Char, Int)]) +-- >>> mv' <- MVU.grow mv 2 +-- +-- Extra elements at the end of the newly allocated vector are initialized to default +-- value, which for primitive vector will always be some form of 0. However, if +-- `unsafeGrow` was used instead this would not have been guaranteed and some garbage +-- would be there instead: +-- +-- >>> VU.unsafeFreeze mv' +-- [('a',10),('b',20),('c',30),('\NUL',0),('\NUL',0)] +-- +-- Having the extra space we can write new values in there: +-- +-- >>> MVU.write mv' 3 ('d', 999) +-- >>> VU.unsafeFreeze mv' +-- [('a',10),('b',20),('c',30),('d',999),('\NUL',0)] +-- +-- It is important to note that the source mutable vector is not affected when +-- the newly allocated one is mutated. +-- +-- >>> MVU.write mv' 2 ('X', 888) +-- >>> VU.unsafeFreeze mv' +-- [('a',10),('b',20),('X',888),('d',999),('\NUL',0)] +-- >>> VU.unsafeFreeze mv +-- [('a',10),('b',20),('c',30)] +-- +-- @since 0.5 grow :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE grow #-} grow = G.grow --- | Grow a vector by the given number of elements. The number must be --- positive but this is not checked. +-- | Grow a vector by the given number of elements. The number must be non-negative but +-- this is not checked. Same semantics as in `G.unsafeGrow` for generic vector. +-- +-- @since 0.5 unsafeGrow :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE unsafeGrow #-}