[Git][ghc/ghc][wip/buggymcbugfix/15185-enum-int] 3 commits: Add INLINABLE pragmas to Enum list producers
Vilem-Benjamin Liepelt
gitlab at gitlab.haskell.org
Sat May 16 19:12:12 UTC 2020
Vilem-Benjamin Liepelt pushed to branch wip/buggymcbugfix/15185-enum-int at Glasgow Haskell Compiler / GHC
Commits:
5e49c27d by buggymcbugfix at 2020-05-16T22:10:54+03:00
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.
- - - - -
accf2ca0 by buggymcbugfix at 2020-05-16T22:10:54+03:00
Piggyback on Enum Word methods for Word64
If we are on a 64 bit platform, we can use the efficient Enum Word
methods for the Enum Word64 instance.
- - - - -
7dc55606 by buggymcbugfix at 2020-05-16T22:10:54+03:00
Document INLINE(ABLE) pragmas that enable fusion
- - - - -
3 changed files:
- libraries/base/GHC/Enum.hs
- libraries/base/GHC/Word.hs
- + testsuite/tests/perf/should_run/T15185.hs
Changes:
=====================================
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
------------------------------------------------------------------------
@@ -343,16 +368,20 @@ instance Enum Char where
toEnum = chr
fromEnum = ord
+ -- See Note [Stable Unfolding for list producers]
{-# INLINE enumFrom #-}
enumFrom (C# x) = eftChar (ord# x) 0x10FFFF#
-- Blarg: technically I guess enumFrom isn't strict!
+ -- See Note [Stable Unfolding for list producers]
{-# INLINE enumFromTo #-}
enumFromTo (C# x) (C# y) = eftChar (ord# x) (ord# y)
+ -- See Note [Stable Unfolding for list producers]
{-# INLINE enumFromThen #-}
enumFromThen (C# x1) (C# x2) = efdChar (ord# x1) (ord# x2)
+ -- See Note [Stable Unfolding for list producers]
{-# INLINE enumFromThenTo #-}
enumFromThenTo (C# x1) (C# x2) (C# y) = efdtChar (ord# x1) (ord# x2) (ord# y)
@@ -472,17 +501,21 @@ instance Enum Int where
toEnum x = x
fromEnum x = x
+ -- See Note [Stable Unfolding for list producers]
{-# INLINE enumFrom #-}
enumFrom (I# x) = eftInt x maxInt#
where !(I# maxInt#) = maxInt
-- Blarg: technically I guess enumFrom isn't strict!
+ -- See Note [Stable Unfolding for list producers]
{-# INLINE enumFromTo #-}
enumFromTo (I# x) (I# y) = eftInt x y
+ -- See Note [Stable Unfolding for list producers]
{-# INLINE enumFromThen #-}
enumFromThen (I# x1) (I# x2) = efdInt x1 x2
+ -- See Note [Stable Unfolding for list producers]
{-# INLINE enumFromThenTo #-}
enumFromThenTo (I# x1) (I# x2) (I# y) = efdtInt x1 x2 y
@@ -812,13 +845,20 @@ instance Enum Integer where
toEnum (I# n) = smallInteger n
fromEnum n = I# (integerToInt n)
+ -- See Note [Stable Unfolding for list producers]
{-# INLINE enumFrom #-}
+ enumFrom x = enumDeltaInteger x 1
+
+ -- See Note [Stable Unfolding for list producers]
{-# INLINE enumFromThen #-}
+ enumFromThen x y = enumDeltaInteger x (y-x)
+
+ -- See Note [Stable Unfolding for list producers]
{-# INLINE enumFromTo #-}
+ enumFromTo x lim = enumDeltaToInteger x 1 lim
+
+ -- See Note [Stable Unfolding for list producers]
{-# INLINE enumFromThenTo #-}
- enumFrom x = enumDeltaInteger x 1
- enumFromThen x y = enumDeltaInteger x (y-x)
- enumFromTo x lim = enumDeltaToInteger x 1 lim
enumFromThenTo x y lim = enumDeltaToInteger x (y-x) lim
-- See Note [How the Enum rules work]
@@ -927,6 +967,7 @@ instance Enum Natural where
toEnum = intToNatural
#if defined(MIN_VERSION_integer_gmp)
+ -- special case here, catch all is after endif
fromEnum (NatS# w)
| i >= 0 = i
| otherwise = errorWithoutStackTrace "fromEnum: out of Int range"
@@ -935,12 +976,22 @@ instance Enum Natural where
#endif
fromEnum n = fromEnum (naturalToInteger n)
+ -- See Note [Stable Unfolding for list producers]
+ {-# INLINABLE enumFrom #-}
enumFrom x = enumDeltaNatural x (wordToNaturalBase 1##)
+
+ -- See Note [Stable Unfolding for list producers]
+ {-# INLINABLE enumFromThen #-}
enumFromThen x y
| x <= y = enumDeltaNatural x (y-x)
| otherwise = enumNegDeltaToNatural x (x-y) (wordToNaturalBase 0##)
+ -- See Note [Stable Unfolding for list producers]
+ {-# INLINABLE enumFromTo #-}
enumFromTo x lim = enumDeltaToNatural x (wordToNaturalBase 1##) lim
+
+ -- See Note [Stable Unfolding for list producers]
+ {-# INLINABLE enumFromThenTo #-}
enumFromThenTo x y lim
| x <= y = enumDeltaToNatural x (y-x) lim
| otherwise = enumNegDeltaToNatural x (x-y) lim
=====================================
libraries/base/GHC/Word.hs
=====================================
@@ -892,10 +892,44 @@ instance Enum Word64 where
| x <= fromIntegral (maxBound::Int)
= I# (word2Int# x#)
| otherwise = fromEnumError "Word64" x
- enumFrom = integralEnumFrom
- enumFromThen = integralEnumFromThen
- enumFromTo = integralEnumFromTo
- enumFromThenTo = integralEnumFromThenTo
+
+#if WORD_SIZE_IN_BITS < 64
+ enumFrom = integralEnumFrom
+ enumFromThen = integralEnumFromThen
+ enumFromTo = integralEnumFromTo
+ enumFromThenTo = integralEnumFromThenTo
+#else
+ -- See Note [Stable Unfolding for list producers] in GHC.Enum
+ {-# INLINABLE enumFrom #-}
+ enumFrom w
+ = map wordToWord64
+ $ enumFrom (word64ToWord w)
+
+ -- See Note [Stable Unfolding for list producers] in GHC.Enum
+ {-# INLINABLE enumFromThen #-}
+ enumFromThen w s
+ = map wordToWord64
+ $ enumFromThen (word64ToWord w) (word64ToWord s)
+
+ -- See Note [Stable Unfolding for list producers] in GHC.Enum
+ {-# INLINABLE enumFromTo #-}
+ enumFromTo w1 w2
+ = map wordToWord64
+ $ enumFromTo (word64ToWord w1) (word64ToWord w2)
+
+ -- See Note [Stable Unfolding for list producers] in GHC.Enum
+ {-# INLINABLE enumFromThenTo #-}
+ enumFromThenTo w1 s w2
+ = map wordToWord64
+ $ enumFromThenTo (word64ToWord w1) (word64ToWord s) (word64ToWord w2)
+
+word64ToWord :: Word64 -> Word
+word64ToWord (W64# w#) = (W# w#)
+
+wordToWord64 :: Word -> Word64
+wordToWord64 (W# w#) = (W64# w#)
+#endif
+
-- | @since 2.01
instance Integral Word64 where
=====================================
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 ()
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/055c2a92d1215f6b076818254c6834a84bb51d0c...7dc556068289dac776d1497dcb32b2d76d5e7373
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/055c2a92d1215f6b076818254c6834a84bb51d0c...7dc556068289dac776d1497dcb32b2d76d5e7373
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200516/98d925e6/attachment-0001.html>
More information about the ghc-commits
mailing list