summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoachim Breitner <mail@joachim-breitner.de>2015-09-02 15:58:38 -0700
committerJoachim Breitner <mail@joachim-breitner.de>2015-09-03 17:13:53 -0700
commit85915e9b73a662f3cc474323ec370d4f61817474 (patch)
treeb07b8105e0fa4966e89003a995fd1a38bdea8dbc
parent79cdb2544d2c68050dbd147936a31e8eb06a4c67 (diff)
downloadhaskell-85915e9b73a662f3cc474323ec370d4f61817474.tar.gz
Make Data.List.foldr1 inline
Previously, foldr1 would be defiend recursively and thus not inline. This is bad, for example, when maximumBy has a strict comparison function: Before the BBP, it was implemented via foldl1, which inlined and yielded good code. With BBP, it goes via foldr1, so we better inline this as well. Fixes #10830. Differential Revision: https://phabricator.haskell.org/D1205
-rw-r--r--libraries/base/GHC/List.hs8
-rw-r--r--testsuite/tests/simplCore/should_run/T10830.hs3
-rw-r--r--testsuite/tests/simplCore/should_run/all.T1
3 files changed, 9 insertions, 3 deletions
diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs
index fcc89d3f8f..ca3fb757e3 100644
--- a/libraries/base/GHC/List.hs
+++ b/libraries/base/GHC/List.hs
@@ -355,9 +355,11 @@ match on everything past the :, which is just the tail of scanl.
-- and thus must be applied to non-empty lists.
foldr1 :: (a -> a -> a) -> [a] -> a
-foldr1 _ [x] = x
-foldr1 f (x:xs) = f x (foldr1 f xs)
-foldr1 _ [] = errorEmptyList "foldr1"
+foldr1 f = go
+ where go [x] = x
+ go (x:xs) = f x (go xs)
+ go [] = errorEmptyList "foldr1"
+{-# INLINE [0] foldr1 #-}
-- | 'scanr' is the right-to-left dual of 'scanl'.
-- Note that
diff --git a/testsuite/tests/simplCore/should_run/T10830.hs b/testsuite/tests/simplCore/should_run/T10830.hs
new file mode 100644
index 0000000000..354f0f513a
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T10830.hs
@@ -0,0 +1,3 @@
+import GHC.OldList
+main :: IO ()
+main = maximumBy compare [1..10000] `seq` return ()
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index 364dfd694f..ba775b7228 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -69,3 +69,4 @@ test('T457', [ only_ways(['normal','optasm']), exit_code(1) ], compile_and_run,
test('T9128', normal, compile_and_run, [''])
test('T9390', normal, compile_and_run, [''])
+test('T10830', extra_run_opts('+RTS -K100k -RTS'), compile_and_run, [''])