Skip to content

Commit

Permalink
Improve haddock of grow functions and clarify their semantics. Fix #36
Browse files Browse the repository at this point in the history
  • Loading branch information
lehins committed Jan 17, 2021
1 parent 9838819 commit 69b09a9
Show file tree
Hide file tree
Showing 6 changed files with 200 additions and 24 deletions.
51 changes: 45 additions & 6 deletions Data/Vector/Generic/Mutable.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 #-}
Expand All @@ -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 #-}
Expand Down Expand Up @@ -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 #-}
Expand Down
5 changes: 3 additions & 2 deletions Data/Vector/Generic/Mutable/Base.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 #-}
Expand Down
42 changes: 38 additions & 4 deletions Data/Vector/Mutable.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 #-}
Expand Down
42 changes: 38 additions & 4 deletions Data/Vector/Primitive/Mutable.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 #-}
Expand Down
42 changes: 38 additions & 4 deletions Data/Vector/Storable/Mutable.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 #-}
Expand Down
42 changes: 38 additions & 4 deletions Data/Vector/Unboxed/Mutable.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 #-}
Expand Down

0 comments on commit 69b09a9

Please sign in to comment.