summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorbuggymcbugfix <4444-buggymcbugfix@users.noreply.gitlab.haskell.org>2020-05-15 14:57:14 +0300
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-05-21 12:18:06 -0400
commitb552e53136abfd6d728563338df99bf899d16139 (patch)
tree45a4492d09e0504b0f20d3f3b657de33e84307c6
parent3451584f98d4a6b26dba4079b9a703e70a49a3ab (diff)
downloadhaskell-b552e53136abfd6d728563338df99bf899d16139.tar.gz
Add INLINABLE pragmas to Enum list producers
The INLINABLE pragmas ensure that we export stable (unoptimised) unfoldings in the interface file so we can do list fusion at usage sites. Related tickets: #15185, #8763, #18178.
-rw-r--r--libraries/base/GHC/Enum.hs35
-rw-r--r--testsuite/tests/perf/should_run/T15185.hs25
-rw-r--r--testsuite/tests/perf/should_run/all.T5
3 files changed, 60 insertions, 5 deletions
diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs
index bf85ca0bbb..cb43c1b8dd 100644
--- a/libraries/base/GHC/Enum.hs
+++ b/libraries/base/GHC/Enum.hs
@@ -139,17 +139,34 @@ class Enum a where
-- * @enumFromThenTo 6 8 2 :: [Int] = []@
enumFromThenTo :: a -> a -> a -> [a]
- succ = toEnum . (+ 1) . fromEnum
- pred = toEnum . (subtract 1) . fromEnum
- enumFrom x = map toEnum [fromEnum x ..]
- enumFromThen x y = map toEnum [fromEnum x, fromEnum y ..]
- enumFromTo x y = map toEnum [fromEnum x .. fromEnum y]
+ succ = toEnum . (+ 1) . fromEnum
+
+ pred = toEnum . (subtract 1) . fromEnum
+
+ -- See Note [Stable Unfolding for list producers]
+ {-# INLINABLE enumFrom #-}
+ enumFrom x = map toEnum [fromEnum x ..]
+
+ -- See Note [Stable Unfolding for list producers]
+ {-# INLINABLE enumFromThen #-}
+ enumFromThen x y = map toEnum [fromEnum x, fromEnum y ..]
+
+ -- See Note [Stable Unfolding for list producers]
+ {-# INLINABLE enumFromTo #-}
+ enumFromTo x y = map toEnum [fromEnum x .. fromEnum y]
+
+ -- See Note [Stable Unfolding for list producers]
+ {-# INLINABLE enumFromThenTo #-}
enumFromThenTo x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y]
+-- See Note [Stable Unfolding for list producers]
+{-# INLINABLE boundedEnumFrom #-}
-- Default methods for bounded enumerations
boundedEnumFrom :: (Enum a, Bounded a) => a -> [a]
boundedEnumFrom n = map toEnum [fromEnum n .. fromEnum (maxBound `asTypeOf` n)]
+-- See Note [Stable Unfolding for list producers]
+{-# INLINABLE boundedEnumFromThen #-}
boundedEnumFromThen :: (Enum a, Bounded a) => a -> a -> [a]
boundedEnumFromThen n1 n2
| i_n2 >= i_n1 = map toEnum [i_n1, i_n2 .. fromEnum (maxBound `asTypeOf` n1)]
@@ -158,6 +175,14 @@ boundedEnumFromThen n1 n2
i_n1 = fromEnum n1
i_n2 = fromEnum n2
+{-
+Note [Stable Unfolding for list producers]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The INLINABLE/INLINE pragmas ensure that we export stable (unoptimised)
+unfoldings in the interface file so we can do list fusion at usage sites.
+-}
+
------------------------------------------------------------------------
-- Helper functions
------------------------------------------------------------------------
diff --git a/testsuite/tests/perf/should_run/T15185.hs b/testsuite/tests/perf/should_run/T15185.hs
new file mode 100644
index 0000000000..e6a01252f4
--- /dev/null
+++ b/testsuite/tests/perf/should_run/T15185.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE TypeApplications #-}
+
+-- Ensure that we do list fusion on `foldr f z [from..to]` for sized `Int` and
+-- `Word` types. Related tickets: #15185, #8763.
+
+import Control.Exception (evaluate)
+import Data.Int
+import Data.Word
+
+fact :: Integral t => t -> t
+fact n = product [1..n]
+
+main :: IO ()
+main = do
+ _ <- evaluate (fact @Int 50)
+ _ <- evaluate (fact @Int64 50)
+ _ <- evaluate (fact @Int32 50)
+ _ <- evaluate (fact @Int16 50)
+ _ <- evaluate (fact @Int8 50)
+ _ <- evaluate (fact @Word 50)
+ _ <- evaluate (fact @Word64 50)
+ _ <- evaluate (fact @Word32 50)
+ _ <- evaluate (fact @Word16 50)
+ _ <- evaluate (fact @Word8 50)
+ pure ()
diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T
index 70bd0fa48c..2ad3a1a546 100644
--- a/testsuite/tests/perf/should_run/all.T
+++ b/testsuite/tests/perf/should_run/all.T
@@ -367,6 +367,11 @@ test('T15578',
compile_and_run,
['-O2'])
+test('T15185',
+ [collect_stats('bytes allocated', 5), only_ways(['normal'])],
+ compile_and_run,
+ ['-O'])
+
# Test performance of creating Uniques.
test('UniqLoop',
[collect_stats('bytes allocated',5),