diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs index bf85ca0bbb7eb6e5f319f85a2ed3138b441123fa..cb43c1b8ddc29d67419c38b64fa548402a7be6b7 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 0000000000000000000000000000000000000000..e6a01252f4734f8bbbefb4bcf77c50db01c35f0f --- /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 70bd0fa48c5e3bd0a32e19b3fd6364aa814fbb89..2ad3a1a546cd88381b513b81ac1952a44f04c306 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),