X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FMonadUtils.hs;fp=compiler%2Futils%2FMonadUtils.hs;h=59bf509079e8ef22fe2a3a2249d86c145933f204;hb=e07185eda0f37bd56ad876a2dfe73c956e432ffc;hp=b1882c349fc5ada3bc96d0acc30a9154205494f6;hpb=393f26621b762225b204b3dc78b05a3ecf08871e;p=ghc-hetmet.git

diff --git a/compiler/utils/MonadUtils.hs b/compiler/utils/MonadUtils.hs
index b1882c3..59bf509 100644
--- a/compiler/utils/MonadUtils.hs
+++ b/compiler/utils/MonadUtils.hs
@@ -13,7 +13,7 @@ module MonadUtils
         , mapAccumLM
         , mapSndM
         , concatMapM
-        , anyM
+        , anyM, allM
         , foldlM, foldrM
         ) where
 
@@ -116,13 +116,18 @@ mapSndM f ((a,b):xs) = do { c <- f b; rs <- mapSndM f xs; return ((a,c):rs) }
 concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
 concatMapM f xs = liftM concat (mapM f xs)
 
--- | Monadic version of 'any', aborts the computation at the first False value
+-- | Monadic version of 'any', aborts the computation at the first @True@ value
 anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
 anyM _ []     = return False
 anyM f (x:xs) = do b <- f x
                    if b then return True 
                         else anyM f xs
 
+-- | Monad version of 'all', aborts the computation at the first @False@ value
+allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
+allM _ []     = return True
+allM f (b:bs) = (f b) >>= (\bv -> if bv then allM f bs else return False)
+
 -- | Monadic version of foldl
 foldlM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
 foldlM = foldM