diff options
author | Joachim Breitner <mail@joachim-breitner.de> | 2015-09-02 15:58:38 -0700 |
---|---|---|
committer | Joachim Breitner <mail@joachim-breitner.de> | 2015-09-02 16:05:55 -0700 |
commit | 6066e1fa6770f2cae3114ab4d4dbde04176863cb (patch) | |
tree | be939e47eea14de6b40e985f61b94c4aeb3afcda | |
parent | bd16e0bc6af13f1347235782935f7dcd40b260e2 (diff) | |
download | haskell-wip/T10830.tar.gz |
Make Data.List.foldr1 inlinewip/T10830
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.
-rw-r--r-- | libraries/base/GHC/List.hs | 8 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_run/T10830.hs | 3 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_run/all.T | 1 |
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, ['']) |