Repository : ssh://darcs.haskell.org//srv/darcs/packages/vector On branch :
http://hackage.haskell.org/trac/ghc/changeset/e119918a5480ec6c73973ac4dc404e34815ac696 >--------------------------------------------------------------- commit e119918a5480ec6c73973ac4dc404e34815ac696 Author: Roman Leshchinskiy <[email protected]> Date: Mon May 16 20:40:22 2011 +0000 Add sequence and sequence_ >--------------------------------------------------------------- Data/Vector.hs | 18 +++++++++++++++++- Data/Vector/Generic.hs | 18 +++++++++++++++++- 2 files changed, 34 insertions(+), 2 deletions(-) diff --git a/Data/Vector.hs b/Data/Vector.hs index ebc8147..8ce8191 100644 --- a/Data/Vector.hs +++ b/Data/Vector.hs @@ -127,6 +127,9 @@ module Data.Vector ( foldM, foldM', fold1M, fold1M', foldM_, foldM'_, fold1M_, fold1M'_, + -- ** Monadic sequencing + sequence, sequence_, + -- * Prefix sums (scans) prescanl, prescanl', postscanl, postscanl', @@ -168,7 +171,7 @@ import Prelude hiding ( length, null, all, any, and, or, sum, product, minimum, maximum, scanl, scanl1, scanr, scanr1, enumFromTo, enumFromThenTo, - mapM, mapM_ ) + mapM, mapM_, sequence, sequence_ ) import qualified Prelude @@ -1208,6 +1211,19 @@ fold1M'_ :: Monad m => (a -> a -> m a) -> Vector a -> m () {-# INLINE fold1M'_ #-} fold1M'_ = G.fold1M'_ +-- Monadic sequencing +-- ------------------ + +-- | Evaluate each action and collect the results +sequence :: Monad m => Vector (m a) -> m (Vector a) +{-# INLINE sequence #-} +sequence = G.sequence + +-- | Evaluate each action and discard the results +sequence_ :: Monad m => Vector (m a) -> m () +{-# INLINE sequence_ #-} +sequence_ = G.sequence_ + -- Prefix sums (scans) -- ------------------- diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs index 30dc1c3..9d837f3 100644 --- a/Data/Vector/Generic.hs +++ b/Data/Vector/Generic.hs @@ -117,6 +117,9 @@ module Data.Vector.Generic ( foldM, foldM', fold1M, fold1M', foldM_, foldM'_, fold1M_, fold1M'_, + -- ** Monadic sequencing + sequence, sequence_, + -- * Prefix sums (scans) prescanl, prescanl', postscanl, postscanl', @@ -183,7 +186,7 @@ import Prelude hiding ( length, null, all, any, and, or, sum, product, maximum, minimum, scanl, scanl1, scanr, scanr1, enumFromTo, enumFromThenTo, - mapM, mapM_ ) + mapM, mapM_, sequence, sequence_ ) import Data.Typeable ( Typeable1, gcast1 ) @@ -1499,6 +1502,19 @@ fold1M'_ :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m () {-# INLINE fold1M'_ #-} fold1M'_ m = discard . Stream.fold1M' m . stream +-- Monadic sequencing +-- ------------------ + +-- | Evaluate each action and collect the results +sequence :: (Monad m, Vector v a, Vector v (m a)) => v (m a) -> m (v a) +{-# INLINE sequence #-} +sequence = mapM id + +-- | Evaluate each action and discard the results +sequence_ :: (Monad m, Vector v (m a)) => v (m a) -> m () +{-# INLINE sequence_ #-} +sequence_ = mapM_ id + -- Prefix sums (scans) -- ------------------- _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
