[commit: ghc] master: Make Data.List.takeWhile fuse: fix #9132 (d14d3f9)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/d14d3f92d55a352db7faf62939127060716c4694/ghc

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

commit d14d3f92d55a352db7faf62939127060716c4694
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Wed Oct 8 08:53:26 2014 +0200

    Make Data.List.takeWhile fuse: fix #9132
    
    Summary:
    Rewrites takeWhile to a build/foldr form; fuses repeated
    applications of takeWhile.
    
    Reviewers: nomeata, austin
    
    Reviewed By: nomeata
    
    Subscribers: thomie, carter, ezyang, simonmar
    
    Projects: #ghc
    
    Differential Revision: https://phabricator.haskell.org/D322
    
    GHC Trac Issues: #9132


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

d14d3f92d55a352db7faf62939127060716c4694
 libraries/base/GHC/List.lhs | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/libraries/base/GHC/List.lhs b/libraries/base/GHC/List.lhs
index 6137249..7792eed 100644
--- a/libraries/base/GHC/List.lhs
+++ b/libraries/base/GHC/List.lhs
@@ -400,12 +400,32 @@ cycle xs                = xs' where xs' = xs ++ xs'
 -- > takeWhile (< 0) [1,2,3] == []
 --
 
+{-# NOINLINE [1] takeWhile #-}
 takeWhile               :: (a -> Bool) -> [a] -> [a]
 takeWhile _ []          =  []
 takeWhile p (x:xs)
             | p x       =  x : takeWhile p xs
             | otherwise =  []
 
+{-# INLINE [0] takeWhileFB #-}
+takeWhileFB :: (a -> Bool) -> (a -> b -> b) -> b -> a -> b -> b
+takeWhileFB p c n = \x r -> if p x then x `c` r else n
+
+-- The takeWhileFB rule is similar to the filterFB rule. It works like this:
+-- takeWhileFB q (takeWhileFB p c n) n =
+-- \x r -> if q x then (takeWhileFB p c n) x r else n =
+-- \x r -> if q x then (\x' r' -> if p x' then x' `c` r' else n) x r else n =
+-- \x r -> if q x then (if p x then x `c` r else n) else n =
+-- \x r -> if q x && p x then x `c` r else n =
+-- takeWhileFB (\x -> q x && p x) c n
+{-# RULES
+"takeWhile"     [~1] forall p xs. takeWhile p xs =
+                                build (\c n -> foldr (takeWhileFB p c n) n xs)
+"takeWhileList" [1]  forall p.    foldr (takeWhileFB p (:) []) [] = takeWhile p
+"takeWhileFB"        forall c n p q. takeWhileFB q (takeWhileFB p c n) n =
+                        takeWhileFB (\x -> q x && p x) c n
+ #-}
+
 -- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@:
 --
 -- > dropWhile (< 3) [1,2,3,4,5,1,2,3] == [3,4,5,1,2,3]