Repository : ssh://darcs.haskell.org//srv/darcs/packages/vector On branch :
http://hackage.haskell.org/trac/ghc/changeset/e7c15f96bf5796f79c6493ff025cf5de865e0e15 >--------------------------------------------------------------- commit e7c15f96bf5796f79c6493ff025cf5de865e0e15 Author: Roman Leshchinskiy <[email protected]> Date: Mon May 16 20:52:27 2011 +0000 Add generateM >--------------------------------------------------------------- Data/Vector.hs | 8 +++++++- Data/Vector/Generic.hs | 8 +++++++- Data/Vector/Primitive.hs | 8 +++++++- Data/Vector/Storable.hs | 8 +++++++- Data/Vector/Unboxed.hs | 8 +++++++- 5 files changed, 35 insertions(+), 5 deletions(-) diff --git a/Data/Vector.hs b/Data/Vector.hs index 8ce8191..745665b 100644 --- a/Data/Vector.hs +++ b/Data/Vector.hs @@ -49,7 +49,7 @@ module Data.Vector ( empty, singleton, replicate, generate, -- ** Monadic initialisation - replicateM, create, + replicateM, generateM, create, -- ** Unfolding unfoldr, unfoldrN, @@ -549,6 +549,12 @@ replicateM :: Monad m => Int -> m a -> m (Vector a) {-# INLINE replicateM #-} replicateM = G.replicateM +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index +generateM :: Monad m => Int -> (Int -> m a) -> m (Vector a) +{-# INLINE generateM #-} +generateM = G.generateM + -- | Execute the monadic action and freeze the resulting vector. -- -- @ diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs index 9d837f3..dc6f9b7 100644 --- a/Data/Vector/Generic.hs +++ b/Data/Vector/Generic.hs @@ -39,7 +39,7 @@ module Data.Vector.Generic ( empty, singleton, replicate, generate, -- ** Monadic initialisation - replicateM, create, + replicateM, generateM, create, -- ** Unfolding unfoldr, unfoldrN, @@ -627,6 +627,12 @@ replicateM :: (Monad m, Vector v a) => Int -> m a -> m (v a) {-# INLINE replicateM #-} replicateM n m = unstreamM (MStream.replicateM n m) +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index +generateM :: (Monad m, Vector v a) => Int -> (Int -> m a) -> m (v a) +{-# INLINE generateM #-} +generateM n f = unstreamM (MStream.generateM n f) + -- | Execute the monadic action and freeze the resulting vector. -- -- @ diff --git a/Data/Vector/Primitive.hs b/Data/Vector/Primitive.hs index 0c9278a..bf0714c 100644 --- a/Data/Vector/Primitive.hs +++ b/Data/Vector/Primitive.hs @@ -42,7 +42,7 @@ module Data.Vector.Primitive ( empty, singleton, replicate, generate, -- ** Monadic initialisation - replicateM, create, + replicateM, generateM, create, -- ** Unfolding unfoldr, unfoldrN, @@ -544,6 +544,12 @@ replicateM :: (Monad m, Prim a) => Int -> m a -> m (Vector a) {-# INLINE replicateM #-} replicateM = G.replicateM +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index +generateM :: (Monad m, Prim a) => Int -> (Int -> m a) -> m (Vector a) +{-# INLINE generateM #-} +generateM = G.generateM + -- | Execute the monadic action and freeze the resulting vector. -- -- @ diff --git a/Data/Vector/Storable.hs b/Data/Vector/Storable.hs index b4e6b91..4ab78b0 100644 --- a/Data/Vector/Storable.hs +++ b/Data/Vector/Storable.hs @@ -39,7 +39,7 @@ module Data.Vector.Storable ( empty, singleton, replicate, generate, -- ** Monadic initialisation - replicateM, create, + replicateM, generateM, create, -- ** Unfolding unfoldr, unfoldrN, @@ -553,6 +553,12 @@ replicateM :: (Monad m, Storable a) => Int -> m a -> m (Vector a) {-# INLINE replicateM #-} replicateM = G.replicateM +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index +generateM :: (Monad m, Storable a) => Int -> (Int -> m a) -> m (Vector a) +{-# INLINE generateM #-} +generateM = G.generateM + -- | Execute the monadic action and freeze the resulting vector. -- -- @ diff --git a/Data/Vector/Unboxed.hs b/Data/Vector/Unboxed.hs index 13c9f0b..8e908d7 100644 --- a/Data/Vector/Unboxed.hs +++ b/Data/Vector/Unboxed.hs @@ -62,7 +62,7 @@ module Data.Vector.Unboxed ( empty, singleton, replicate, generate, -- ** Monadic initialisation - replicateM, create, + replicateM, generateM, create, -- ** Unfolding unfoldr, unfoldrN, @@ -523,6 +523,12 @@ replicateM :: (Monad m, Unbox a) => Int -> m a -> m (Vector a) {-# INLINE replicateM #-} replicateM = G.replicateM +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index +generateM :: (Monad m, Unbox a) => Int -> (Int -> m a) -> m (Vector a) +{-# INLINE generateM #-} +generateM = G.generateM + -- | Execute the monadic action and freeze the resulting vector. -- -- @ _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
