[commit: ghc] wip/T13351: Revise list fusion for and, or, all, any, elem, notElem (#13351) (339a178)

[git at git.haskell.org]

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

On branch  : wip/T13351
Link       : http://ghc.haskell.org/trac/ghc/changeset/339a1784efd9ebf08a30765e092eef53712970c3/ghc

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

commit 339a1784efd9ebf08a30765e092eef53712970c3
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Tue Feb 28 12:20:02 2017 -0800

    Revise list fusion for and, or, all, any, elem, notElem (#13351)
    
    to make sure their list fusion is implemented in terms of foldr (and not
    build directly), with proper writing-back rules.
    
    This ensures that, for example,
    
        c `elem` "!@#$%^&*()"
    
    works without actual list code.
    
    Also, for good measure, add foldr fusion rules for short lists, and
    make the comment there more useful.
    
    Differential Revision: https://phabricator.haskell.org/D3246


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

339a1784efd9ebf08a30765e092eef53712970c3
 libraries/base/GHC/Base.hs | 19 +++++++++++------
 libraries/base/GHC/List.hs | 52 +++++++++++++++++++++++++++++++++-------------
 2 files changed, 51 insertions(+), 20 deletions(-)

diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs
index e07c077..b5fa91c 100644
--- a/libraries/base/GHC/Base.hs
+++ b/libraries/base/GHC/Base.hs
@@ -897,16 +897,23 @@ augment g xs = g (:) xs
         -- Only activate this from phase 1, because that's
         -- when we disable the rule that expands (++) into foldr
 
+"foldr/nil"    forall k z.             foldr k z []             = z
+"foldr/single" forall k z x.           foldr k z [x]            = k x z
+"foldr/short2" forall k z x1 x2.       foldr k z [x1,x2]        = k x1 (k x2 z)
+"foldr/short3" forall k z x1 x2 x3.    foldr k z [x1,x2,x3]     = k x1 (k x2 (k x3 z))
+"foldr/short4" forall k z x1 x2 x3 x4. foldr k z [x1,x2,x3,x4]  = k x1 (k x2 (k x3 (k x4 z)))
+
+-- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
 -- The foldr/cons rule looks nice, but it can give disastrously
 -- bloated code when commpiling
 --      array (a,b) [(1,2), (2,2), (3,2), ...very long list... ]
 -- i.e. when there are very very long literal lists
--- So I've disabled it for now. We could have special cases
--- for short lists, I suppose.
--- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
-
-"foldr/single"  forall k z x. foldr k z [x] = k x z
-"foldr/nil"     forall k z.   foldr k z []  = z
+-- So we disabled it, but have special cases for short lists up
+-- to a completely arbitrary limit of 4.
+--
+-- Note that static lists that are explicitly entered as such in the source,
+-- the compiler desugars them to build (if they are short), and then normal
+-- foldr/build rule fires, see note [Desugaring explicit lists] in DsExpr
 
 "foldr/cons/build" forall k z x (g::forall b. (a->b->b) -> b -> b) .
                            foldr k z (x:build g) = k x (g k z)
diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs
index 3eab407..7b6c059 100644
--- a/libraries/base/GHC/List.hs
+++ b/libraries/base/GHC/List.hs
@@ -730,9 +730,13 @@ and []          =  True
 and (x:xs)      =  x && and xs
 {-# NOINLINE [1] and #-}
 
+andFB :: Bool -> Bool -> Bool
+andFB x r = x && r
+{-# NOINLINE [0] andFB #-}
+
 {-# RULES
-"and/build"     forall (g::forall b.(Bool->b->b)->b->b) .
-                and (build g) = g (&&) True
+"and"     [~1] forall xs. and xs = foldr andFB True xs
+"andList"  [1]            foldr andFB True = and
  #-}
 #endif
 
@@ -747,9 +751,13 @@ or []           =  False
 or (x:xs)       =  x || or xs
 {-# NOINLINE [1] or #-}
 
+orFB :: Bool -> Bool -> Bool
+orFB x r = x || r
+{-# NOINLINE [0] orFB #-}
+
 {-# RULES
-"or/build"      forall (g::forall b.(Bool->b->b)->b->b) .
-                or (build g) = g (||) False
+"or"     [~1] forall xs. or xs = foldr orFB False xs
+"orList"  [1]            foldr orFB False = or
  #-}
 #endif
 
@@ -764,12 +772,15 @@ any p                   =  or . map p
 #else
 any _ []        = False
 any p (x:xs)    = p x || any p xs
-
 {-# NOINLINE [1] any #-}
 
+anyFB :: (t -> Bool) -> t -> Bool -> Bool
+anyFB p x r = p x || r
+{-# NOINLINE [0] anyFB #-}
+
 {-# RULES
-"any/build"     forall p (g::forall b.(a->b->b)->b->b) .
-                any p (build g) = g ((||) . p) False
+"any"     [~1] forall p xs. any p xs = foldr (anyFB p) False xs
+"anyList"  [1] forall p.    foldr (anyFB p) False = any p
  #-}
 #endif
 
@@ -783,12 +794,15 @@ all p                   =  and . map p
 #else
 all _ []        =  True
 all p (x:xs)    =  p x && all p xs
-
 {-# NOINLINE [1] all #-}
 
+allFB :: (t -> Bool) -> t -> Bool -> Bool
+allFB p x r = p x && r
+{-# NOINLINE [0] allFB #-}
+
 {-# RULES
-"all/build"     forall p (g::forall b.(a->b->b)->b->b) .
-                all p (build g) = g ((&&) . p) True
+"all"     [~1] forall p xs. all p xs = foldr (allFB p) True xs
+"allList"  [1] forall p.    foldr (allFB p) True = all p
  #-}
 #endif
 
@@ -803,9 +817,14 @@ elem x                  =  any (== x)
 elem _ []       = False
 elem x (y:ys)   = x==y || elem x ys
 {-# NOINLINE [1] elem #-}
+
+elemFB :: Eq a => a -> a -> Bool -> Bool
+elemFB x y r = (x == y) || r
+{-# NOINLINE [0] elemFB #-}
+
 {-# RULES
-"elem/build"    forall x (g :: forall b . Eq a => (a -> b -> b) -> b -> b)
-   . elem x (build g) = g (\ y r -> (x == y) || r) False
+"elem"     [~1] forall x xs. elem x xs = foldr (elemFB x) False xs
+"elemList"  [1] forall x.    foldr (elemFB x) False = elem x
  #-}
 #endif
 
@@ -817,9 +836,14 @@ notElem x               =  all (/= x)
 notElem _ []    =  True
 notElem x (y:ys)=  x /= y && notElem x ys
 {-# NOINLINE [1] notElem #-}
+
+notElemFB :: Eq a => a -> a -> Bool -> Bool
+notElemFB x y r = (x /= y) && r
+{-# NOINLINE [0] notElemFB #-}
+
 {-# RULES
-"notElem/build" forall x (g :: forall b . Eq a => (a -> b -> b) -> b -> b)
-   . notElem x (build g) = g (\ y r -> (x /= y) && r) True
+"notElem"     [~1] forall x xs. notElem x xs = foldr (notElemFB x) False xs
+"notElemList"  [1] forall x.    foldr (notElemFB x) True = notElem x
  #-}
 #endif