Repository : ssh://darcs.haskell.org//srv/darcs/packages/vector On branch :
http://hackage.haskell.org/trac/ghc/changeset/a91bb446ca28e807617ad55e4fef6b8d0ce69ce6 >--------------------------------------------------------------- commit a91bb446ca28e807617ad55e4fef6b8d0ce69ce6 Author: Roman Leshchinskiy <[email protected]> Date: Mon May 16 20:06:15 2011 +0000 Add foldM_ and variants >--------------------------------------------------------------- Data/Vector.hs | 22 ++++++++++++++++++++++ Data/Vector/Generic.hs | 26 ++++++++++++++++++++++++++ Data/Vector/Primitive.hs | 22 ++++++++++++++++++++++ Data/Vector/Storable.hs | 22 ++++++++++++++++++++++ Data/Vector/Unboxed.hs | 22 ++++++++++++++++++++++ 5 files changed, 114 insertions(+), 0 deletions(-) diff --git a/Data/Vector.hs b/Data/Vector.hs index eae0f0f..ebc8147 100644 --- a/Data/Vector.hs +++ b/Data/Vector.hs @@ -125,6 +125,7 @@ module Data.Vector ( -- ** Monadic folds foldM, foldM', fold1M, fold1M', + foldM_, foldM'_, fold1M_, fold1M'_, -- * Prefix sums (scans) prescanl, prescanl', @@ -1186,6 +1187,27 @@ fold1M' :: Monad m => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M' #-} fold1M' = G.fold1M' +-- | /O(n)/ Monadic fold that discards the result +foldM_ :: Monad m => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM_ #-} +foldM_ = G.foldM_ + +-- | /O(n)/ Monadic fold over non-empty vectors that discards the result +fold1M_ :: Monad m => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M_ #-} +fold1M_ = G.fold1M_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +foldM'_ :: Monad m => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM'_ #-} +foldM'_ = G.foldM'_ + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +-- that discards the result +fold1M'_ :: Monad m => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ = G.fold1M'_ + -- Prefix sums (scans) -- ------------------- diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs index 49e94f9..30dc1c3 100644 --- a/Data/Vector/Generic.hs +++ b/Data/Vector/Generic.hs @@ -115,6 +115,7 @@ module Data.Vector.Generic ( -- ** Monadic folds foldM, foldM', fold1M, fold1M', + foldM_, foldM'_, fold1M_, fold1M'_, -- * Prefix sums (scans) prescanl, prescanl', @@ -1473,6 +1474,31 @@ fold1M' :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m a {-# INLINE fold1M' #-} fold1M' m = Stream.fold1M' m . stream +discard :: Monad m => m a -> m () +{-# INLINE discard #-} +discard m = m >> return () + +-- | /O(n)/ Monadic fold that discards the result +foldM_ :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m () +{-# INLINE foldM_ #-} +foldM_ m z = discard . Stream.foldM m z . stream + +-- | /O(n)/ Monadic fold over non-empty vectors that discards the result +fold1M_ :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m () +{-# INLINE fold1M_ #-} +fold1M_ m = discard . Stream.fold1M m . stream + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +foldM'_ :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m () +{-# INLINE foldM'_ #-} +foldM'_ m z = discard . Stream.foldM' m z . stream + +-- | /O(n)/ Monad fold over non-empty vectors with strict accumulator +-- that discards the result +fold1M'_ :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ m = discard . Stream.fold1M' m . stream + -- Prefix sums (scans) -- ------------------- diff --git a/Data/Vector/Primitive.hs b/Data/Vector/Primitive.hs index 5bb5726..0c9278a 100644 --- a/Data/Vector/Primitive.hs +++ b/Data/Vector/Primitive.hs @@ -111,6 +111,7 @@ module Data.Vector.Primitive ( -- ** Monadic folds foldM, foldM', fold1M, fold1M', + foldM_, foldM'_, fold1M_, fold1M'_, -- * Prefix sums (scans) prescanl, prescanl', @@ -1088,6 +1089,27 @@ fold1M' :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M' #-} fold1M' = G.fold1M' +-- | /O(n)/ Monadic fold that discards the result +foldM_ :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM_ #-} +foldM_ = G.foldM_ + +-- | /O(n)/ Monadic fold over non-empty vectors that discards the result +fold1M_ :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M_ #-} +fold1M_ = G.fold1M_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +foldM'_ :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM'_ #-} +foldM'_ = G.foldM'_ + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +-- that discards the result +fold1M'_ :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ = G.fold1M'_ + -- Prefix sums (scans) -- ------------------- diff --git a/Data/Vector/Storable.hs b/Data/Vector/Storable.hs index 7f76ebb..b4e6b91 100644 --- a/Data/Vector/Storable.hs +++ b/Data/Vector/Storable.hs @@ -108,6 +108,7 @@ module Data.Vector.Storable ( -- ** Monadic folds foldM, foldM', fold1M, fold1M', + foldM_, foldM'_, fold1M_, fold1M'_, -- * Prefix sums (scans) prescanl, prescanl', @@ -1107,6 +1108,27 @@ fold1M' :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M' #-} fold1M' = G.fold1M' +-- | /O(n)/ Monadic fold that discards the result +foldM_ :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM_ #-} +foldM_ = G.foldM_ + +-- | /O(n)/ Monadic fold over non-empty vectors that discards the result +fold1M_ :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M_ #-} +fold1M_ = G.fold1M_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +foldM'_ :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM'_ #-} +foldM'_ = G.foldM'_ + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +-- that discards the result +fold1M'_ :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ = G.fold1M'_ + -- Prefix sums (scans) -- ------------------- diff --git a/Data/Vector/Unboxed.hs b/Data/Vector/Unboxed.hs index 7d65408..13c9f0b 100644 --- a/Data/Vector/Unboxed.hs +++ b/Data/Vector/Unboxed.hs @@ -138,6 +138,7 @@ module Data.Vector.Unboxed ( -- ** Monadic folds foldM, foldM', fold1M, fold1M', + foldM_, foldM'_, fold1M_, fold1M'_, -- * Prefix sums (scans) prescanl, prescanl', @@ -1128,6 +1129,27 @@ fold1M' :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M' #-} fold1M' = G.fold1M' +-- | /O(n)/ Monadic fold that discards the result +foldM_ :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM_ #-} +foldM_ = G.foldM_ + +-- | /O(n)/ Monadic fold over non-empty vectors that discards the result +fold1M_ :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M_ #-} +fold1M_ = G.fold1M_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +foldM'_ :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM'_ #-} +foldM'_ = G.foldM'_ + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +-- that discards the result +fold1M'_ :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ = G.fold1M'_ + -- Prefix sums (scans) -- ------------------- _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
