summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSebastian Graf <sebastian.graf@kit.edu>2023-02-27 21:38:21 +0100
committerBen Gamari <ben@smart-cactus.org>2023-03-02 10:16:14 -0500
commit0105758bd2596c5147403ec3348b091002e7a92f (patch)
treee30b303a36973a769388536d35b789ba80d87961
parent3b9bf327243f0167b2c486b036812273e24dc394 (diff)
downloadhaskell-0105758bd2596c5147403ec3348b091002e7a92f.tar.gz
Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)"
This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 (cherry picked from commit a2a1a1c08bb520b74b00194a83add82b287b38d5)
-rw-r--r--libraries/base/GHC/List.hs41
-rw-r--r--testsuite/tests/perf/should_run/T18964.hs3
-rw-r--r--testsuite/tests/perf/should_run/T23021.hs30
-rw-r--r--testsuite/tests/perf/should_run/T23021.stdout12
-rw-r--r--testsuite/tests/perf/should_run/all.T3
5 files changed, 56 insertions, 33 deletions
diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs
index 658dabe302..2bd91015b7 100644
--- a/libraries/base/GHC/List.hs
+++ b/libraries/base/GHC/List.hs
@@ -886,23 +886,12 @@ takeWhileFB p c n = \x r -> if p x then x `c` r else n
-- []
-- >>> dropWhile (< 0) [1,2,3]
-- [1,2,3]
-{-# NOINLINE [1] dropWhile #-}
dropWhile :: (a -> Bool) -> [a] -> [a]
dropWhile _ [] = []
dropWhile p xs@(x:xs')
| p x = dropWhile p xs'
| otherwise = xs
-{-# INLINE [0] dropWhileFB #-} -- See Note [Inline FB functions]
-dropWhileFB :: (a -> Bool) -> (a -> b -> b) -> b -> a -> (Bool -> b) -> Bool -> b
-dropWhileFB p c _n x xs = \drp -> if drp && p x then xs True else x `c` xs False
-
-{-# RULES
-"dropWhile" [~1] forall p xs. dropWhile p xs =
- build (\c n -> foldr (dropWhileFB p c n) (flipSeq n) xs True)
-"dropWhileList" [1] forall p xs. foldr (dropWhileFB p (:) []) (flipSeq []) xs True = dropWhile p xs
- #-}
-
-- | 'take' @n@, applied to a list @xs@, returns the prefix of @xs@
-- of length @n@, or @xs@ itself if @n >= 'length' xs@.
--
@@ -998,31 +987,17 @@ drop n xs | n <= 0 = xs
drop _ [] = []
drop n (_:xs) = drop (n-1) xs
#else /* hack away */
-{-# INLINE[1] drop #-} -- Why [1]? See justification on take! => RULES
+{-# INLINE drop #-}
drop n ls
| n <= 0 = ls
| otherwise = unsafeDrop n ls
-
--- A version of drop that drops the whole list if given an argument
--- less than 1
-{-# NOINLINE [0] unsafeDrop #-} -- See Note [Inline FB functions]
-unsafeDrop :: Int -> [a] -> [a]
-unsafeDrop !_ [] = []
-unsafeDrop 1 (_:xs) = xs
-unsafeDrop m (_:xs) = unsafeDrop (m - 1) xs
-
-{-# RULES
-"drop" [~1] forall n xs . drop n xs =
- build (\c nil -> if n <= 0
- then foldr c nil xs
- else foldr (dropFB c nil) (flipSeq nil) xs n)
-"unsafeDropList" [1] forall n xs . foldr (dropFB (:) []) (flipSeq []) xs n
- = unsafeDrop n xs
- #-}
-
-{-# INLINE [0] dropFB #-} -- See Note [Inline FB functions]
-dropFB :: (a -> b -> b) -> b -> a -> (Int -> b) -> Int -> b
-dropFB c _n x xs = \ m -> if m <= 0 then x `c` xs m else xs (m-1)
+ where
+ -- A version of drop that drops the whole list if given an argument
+ -- less than 1
+ unsafeDrop :: Int -> [a] -> [a]
+ unsafeDrop !_ [] = []
+ unsafeDrop 1 (_:xs) = xs
+ unsafeDrop m (_:xs) = unsafeDrop (m - 1) xs
#endif
-- | 'splitAt' @n xs@ returns a tuple where first element is @xs@ prefix of
diff --git a/testsuite/tests/perf/should_run/T18964.hs b/testsuite/tests/perf/should_run/T18964.hs
index e9c7b915e7..8b6b0a0717 100644
--- a/testsuite/tests/perf/should_run/T18964.hs
+++ b/testsuite/tests/perf/should_run/T18964.hs
@@ -3,6 +3,9 @@ import Data.Int
main :: IO ()
main = do
+ -- This test aims to track #18964, the fix of which had to be reverted in the
+ -- wake of #23021. The comments below apply to a world where #18964 is fixed.
+ --------------------
-- drop should fuse away and the program should consume O(1) space
-- If fusion fails, this allocates about 640MB.
print $ sum $ drop 10 [0..10000000::Int64]
diff --git a/testsuite/tests/perf/should_run/T23021.hs b/testsuite/tests/perf/should_run/T23021.hs
new file mode 100644
index 0000000000..f68e7ecbcb
--- /dev/null
+++ b/testsuite/tests/perf/should_run/T23021.hs
@@ -0,0 +1,30 @@
+-- The direct implementation of drop and dropWhile operates in O(1) space.
+-- This regression test asserts that potential fusion rules for dropWhile/drop
+-- maintain that property for the fused pipelines in dropWhile2 and drop2 (which
+-- are marked NOINLINE for that purpose).
+-- #23021 was opened because we had fusion rules in place that did not maintain
+-- this property.
+
+dropWhile2 :: Int -> [Int] -> [Int]
+dropWhile2 n = dropWhile (< n) . dropWhile (< n)
+{-# NOINLINE dropWhile2 #-}
+
+drop2 :: Int -> [Int] -> [Int]
+drop2 n = drop n . drop n
+{-# NOINLINE drop2 #-}
+
+main :: IO ()
+main = do
+ let xs = [0..9999999]
+ print $ last $ dropWhile2 0 xs
+ print $ last $ dropWhile2 1 xs
+ print $ last $ dropWhile2 2 xs
+ print $ last $ dropWhile2 3 xs
+ print $ last $ dropWhile2 4 xs
+ print $ last $ dropWhile2 5 xs
+ print $ last $ drop2 0 xs
+ print $ last $ drop2 1 xs
+ print $ last $ drop2 2 xs
+ print $ last $ drop2 3 xs
+ print $ last $ drop2 4 xs
+ print $ last $ drop2 5 xs
diff --git a/testsuite/tests/perf/should_run/T23021.stdout b/testsuite/tests/perf/should_run/T23021.stdout
new file mode 100644
index 0000000000..2b2ad97061
--- /dev/null
+++ b/testsuite/tests/perf/should_run/T23021.stdout
@@ -0,0 +1,12 @@
+9999999
+9999999
+9999999
+9999999
+9999999
+9999999
+9999999
+9999999
+9999999
+9999999
+9999999
+9999999
diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T
index ba75906c7d..6819e7b7de 100644
--- a/testsuite/tests/perf/should_run/all.T
+++ b/testsuite/tests/perf/should_run/all.T
@@ -409,4 +409,7 @@ test('T21839r',
compile_and_run,
['-O'])
+# #18964 should be marked expect_broken, but it's still useful to track that
+# perf doesn't regress further, so it is not marked as such.
test('T18964', [collect_stats('bytes allocated', 1), only_ways(['normal'])], compile_and_run, ['-O'])
+test('T23021', [collect_stats('bytes allocated', 1), only_ways(['normal'])], compile_and_run, ['-O2'])