[commit: ghc] wip/T13351: Revise list fusion for and, or, all, any, elem, notElem (#13351) (8aa35df)
git at git.haskell.org
git at git.haskell.org
Wed Mar 1 18:14:56 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/T13351
Link : http://ghc.haskell.org/trac/ghc/changeset/8aa35dfa94be50b89e41fd48aa8e78cb72032aa8/ghc
>---------------------------------------------------------------
commit 8aa35dfa94be50b89e41fd48aa8e78cb72032aa8
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
>---------------------------------------------------------------
8aa35dfa94be50b89e41fd48aa8e78cb72032aa8
libraries/base/GHC/Base.hs | 19 ++++++----
libraries/base/GHC/List.hs | 52 +++++++++++++++++++--------
testsuite/tests/simplCore/should_run/T2110.hs | 1 +
3 files changed, 52 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
diff --git a/testsuite/tests/simplCore/should_run/T2110.hs b/testsuite/tests/simplCore/should_run/T2110.hs
index 610be09..7cde608 100644
--- a/testsuite/tests/simplCore/should_run/T2110.hs
+++ b/testsuite/tests/simplCore/should_run/T2110.hs
@@ -19,6 +19,7 @@ same x y = case reallyUnsafePtrEquality# (unsafeCoerce x) y of
main = do
let l = [1,2,3]
+ {-# NOINLINE l #-}
same (fooAge l) l
same (fooCoerce l) l
same (fooUnsafeCoerce l) l
More information about the ghc-commits
mailing list