diff --git a/vector/src/Data/Vector.hs b/vector/src/Data/Vector.hs index c7d044c7..15713b8c 100644 --- a/vector/src/Data/Vector.hs +++ b/vector/src/Data/Vector.hs @@ -1059,13 +1059,16 @@ unsafeBackpermute = G.unsafeBackpermute -- Safe destructive updates -- ------------------------ --- | Apply a destructive operation to a vector. The operation will be +-- | Apply a destructive operation to a vector. The operation may be -- performed in place if it is safe to do so and will modify a copy of the --- vector otherwise. +-- vector otherwise (See 'Data.Vector.Generic.New.New' for details). -- --- @ --- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> --- @ +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> import qualified Data.Vector.Mutable as MV +-- >>> modify (\v -> MV.write v 0 'x') $ V.replicate 4 'a' +-- "xaaa" modify :: (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a {-# INLINE modify #-} modify p = G.modify p diff --git a/vector/src/Data/Vector/Generic.hs b/vector/src/Data/Vector/Generic.hs index 11f39fa7..66a6b7be 100644 --- a/vector/src/Data/Vector/Generic.hs +++ b/vector/src/Data/Vector/Generic.hs @@ -1015,13 +1015,16 @@ unsafeBackpermute v is = seq v -- Safe destructive updates -- ------------------------ --- | Apply a destructive operation to a vector. The operation will be +-- | Apply a destructive operation to a vector. The operation may be -- performed in place if it is safe to do so and will modify a copy of the --- vector otherwise. +-- vector otherwise (See 'Data.Vector.Generic.New.New' for details). -- --- @ --- modify (\\v -> 'M.write' v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> --- @ +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> import qualified Data.Vector.Mutable as MV +-- >>> modify (\v -> MV.write v 0 'x') $ V.replicate 4 'a' +-- "xaaa" modify :: Vector v a => (forall s. Mutable v s a -> ST s ()) -> v a -> v a {-# INLINE modify #-} modify p = new . New.modify p . clone diff --git a/vector/src/Data/Vector/Generic/New.hs b/vector/src/Data/Vector/Generic/New.hs index f4105c33..6afd668e 100644 --- a/vector/src/Data/Vector/Generic/New.hs +++ b/vector/src/Data/Vector/Generic/New.hs @@ -18,10 +18,13 @@ -- module Data.Vector.Generic.New ( + -- * Array recycling primitives New(..), create, run, runPrim, apply, modify, modifyWithBundle, unstream, transform, unstreamR, transformR, slice, init, tail, take, drop, unsafeSlice, unsafeInit, unsafeTail + -- * References + -- $references ) where import qualified Data.Vector.Generic.Mutable as MVector @@ -45,6 +48,13 @@ import Prelude #define NOT_VECTOR_MODULE #include "vector.h" +-- | This data type is a wrapper around a monadic action which produces +-- a mutable vector. It's used by a number of rewrite rules in order to +-- facilitate the reuse of buffers allocated for vectors. See "Recycle +-- your arrays!" for a detailed explanation. +-- +-- Note that this data type must be declared as @data@ and not @newtype@ +-- since it's used for rewrite rules and rules won't fire with @newtype@. data New v a = New (forall s. ST s (Mutable v s a)) create :: (forall s. ST s (Mutable v s a)) -> New v a @@ -183,3 +193,9 @@ unsafeTail m = apply MVector.unsafeTail m unsafeTail (unstream s) = unstream (Bundle.tail s) #-} +-- $references +-- +-- * Leshchinskiy, Roman. "Recycle your arrays!." Practical Aspects of +-- Declarative Languages: 11th International Symposium, PADL 2009, +-- Savannah, GA, USA, January 19-20, 2009. Proceedings 11. Springer +-- Berlin Heidelberg, 2009. diff --git a/vector/src/Data/Vector/Primitive.hs b/vector/src/Data/Vector/Primitive.hs index 3259bdd0..f41b3056 100644 --- a/vector/src/Data/Vector/Primitive.hs +++ b/vector/src/Data/Vector/Primitive.hs @@ -853,13 +853,16 @@ unsafeBackpermute = G.unsafeBackpermute -- Safe destructive updates -- ------------------------ --- | Apply a destructive operation to a vector. The operation will be +-- | Apply a destructive operation to a vector. The operation may be -- performed in place if it is safe to do so and will modify a copy of the --- vector otherwise. +-- vector otherwise (see 'Data.Vector.Generic.New.New' for details). -- --- @ --- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> --- @ +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> import qualified Data.Vector.Primitive.Mutable as MVP +-- >>> VP.modify (\v -> MVP.write v 0 'x') $ VP.replicate 4 'a' +-- "xaaa" modify :: Prim a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a {-# INLINE modify #-} modify p = G.modify p diff --git a/vector/src/Data/Vector/Storable.hs b/vector/src/Data/Vector/Storable.hs index c798a5aa..0fab3d8e 100644 --- a/vector/src/Data/Vector/Storable.hs +++ b/vector/src/Data/Vector/Storable.hs @@ -864,13 +864,16 @@ unsafeBackpermute = G.unsafeBackpermute -- Safe destructive updates -- ------------------------ --- | Apply a destructive operation to a vector. The operation will be +-- | Apply a destructive operation to a vector. The operation may be -- performed in place if it is safe to do so and will modify a copy of the --- vector otherwise. +-- vector otherwise (see 'Data.Vector.Generic.New.New' for details). -- --- @ --- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> --- @ +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> import qualified Data.Vector.Storable.Mutable as MVS +-- >>> VS.modify (\v -> MVS.write v 0 'x') $ VS.replicate 4 'a' +-- "xaaa" modify :: Storable a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a {-# INLINE modify #-} modify p = G.modify p diff --git a/vector/src/Data/Vector/Unboxed.hs b/vector/src/Data/Vector/Unboxed.hs index 42d3e167..d6110699 100644 --- a/vector/src/Data/Vector/Unboxed.hs +++ b/vector/src/Data/Vector/Unboxed.hs @@ -871,13 +871,16 @@ unsafeBackpermute = G.unsafeBackpermute -- Safe destructive updates -- ------------------------ --- | Apply a destructive operation to a vector. The operation will be +-- | Apply a destructive operation to a vector. The operation may be -- performed in place if it is safe to do so and will modify a copy of the --- vector otherwise. +-- vector otherwise (see 'Data.Vector.Generic.New.New' for details). -- --- @ --- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> --- @ +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> import qualified Data.Vector.Unboxed.Mutable as MVU +-- >>> VU.modify (\v -> MVU.write v 0 'x') $ VU.replicate 4 'a' +-- "xaaa" modify :: Unbox a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a {-# INLINE modify #-} modify p = G.modify p