[commit: ghc] wip/validate-T9546: Make filterM a good consumer (18dc732)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/validate-T9546
Link       : http://ghc.haskell.org/trac/ghc/changeset/18dc7324765b04781158d2a97b6bdbd07812bff4/ghc

>---------------------------------------------------------------

commit 18dc7324765b04781158d2a97b6bdbd07812bff4
Author: David Feuer <David.Feuer at gmail.com>
Date:   Wed Oct 1 15:59:39 2014 +0200

    Make filterM a good consumer
    
    analogously to mapM. Fixes #9546.


>---------------------------------------------------------------

18dc7324765b04781158d2a97b6bdbd07812bff4
 libraries/base/Control/Monad.hs | 12 +++++++-----
 libraries/base/changelog.md     |  3 ++-
 2 files changed, 9 insertions(+), 6 deletions(-)

diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs
index 619a2ba..db46dea 100644
--- a/libraries/base/Control/Monad.hs
+++ b/libraries/base/Control/Monad.hs
@@ -93,12 +93,14 @@ guard False     =  empty
 
 -- | This generalizes the list-based 'filter' function.
 
+{-# INLINE filterM #-}
 filterM          :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
-filterM _ []     =  return []
-filterM p (x:xs) =  do
-   flg <- p x
-   ys  <- filterM p xs
-   return (if flg then x:ys else ys)
+filterM p        = foldr go (return [])
+  where
+    go x r = do
+      flg <- p x
+      ys <- r
+      return (if flg then x:ys else ys)
 
 infixr 1 <=<, >=>
 
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 09b749a..f7d8b1c 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -77,7 +77,8 @@
     second argument, so that the fusion RULES for it do not change the
     semantics. (#9596)
 
-  * `scanr` and `mapAccumL` now take part in list fusion (#9355, #9502)
+  * `scanr`, `mapAccumL` and `filterM` now take part in list fusion (#9355,
+    #9502, #9546)
 
 ## 4.7.0.1  *Jul 2014*