summaryrefslogtreecommitdiff
path: root/libraries
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2021-10-06 12:35:58 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-10-07 20:20:01 -0400
commit44886aaba46230de003fb99153a3120667225302 (patch)
tree30fa4a9f9202da98cd1a26af1f848e23a19b1a5c /libraries
parente1d02fb0f04bcf3acea1da96d291a03bb749718d (diff)
downloadhaskell-44886aaba46230de003fb99153a3120667225302.tar.gz
Bignum: allow inlining of naturalEq/Ne/Gt/Lt/Ge/Le/Compare (#20361)
Perform constant folding on bigNatCompare instead. Some functions of the Enum class for Natural now need to be inlined explicitly to be specialized at call sites (because `x > lim` for Natural is inlined and the resulting function is a little too big to inline). If we don't do this, T17499 runtime allocations regresses by 16%.
Diffstat (limited to 'libraries')
-rw-r--r--libraries/base/GHC/Enum.hs14
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/BigNat.hs1
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/Natural.hs5
3 files changed, 15 insertions, 5 deletions
diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs
index 096e633894..4292592f44 100644
--- a/libraries/base/GHC/Enum.hs
+++ b/libraries/base/GHC/Enum.hs
@@ -989,12 +989,22 @@ instance Enum Natural where
i = I# (word2Int# w)
fromEnum _ = errorWithoutStackTrace "fromEnum: out of Int range"
+ -- See Note [Stable Unfolding for list producers]
+ {-# INLINE enumFrom #-}
enumFrom x = enumDeltaNatural x 1
+
+ -- See Note [Stable Unfolding for list producers]
+ {-# INLINE enumFromThen #-}
enumFromThen x y
| x <= y = enumDeltaNatural x (y-x)
| otherwise = enumNegDeltaToNatural x (x-y) 0
+ -- See Note [Stable Unfolding for list producers]
+ {-# INLINE enumFromTo #-}
enumFromTo x lim = enumDeltaToNatural x 1 lim
+
+ -- See Note [Stable Unfolding for list producers]
+ {-# INLINE enumFromThenTo #-}
enumFromThenTo x y lim
| x <= y = enumDeltaToNatural x (y-x) lim
| otherwise = enumNegDeltaToNatural x (x-y) lim
@@ -1004,12 +1014,16 @@ instance Enum Natural where
enumDeltaNatural :: Natural -> Natural -> [Natural]
enumDeltaNatural !x d = x : enumDeltaNatural (x+d) d
+-- Inline to specialize
+{-# INLINE enumDeltaToNatural #-}
enumDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]
enumDeltaToNatural x0 delta lim = go x0
where
go x | x > lim = []
| otherwise = x : go (x+delta)
+-- Inline to specialize
+{-# INLINE enumNegDeltaToNatural #-}
enumNegDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]
enumNegDeltaToNatural x0 ndelta lim = go x0
where
diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs
index 1e6acaf9cc..7749ffcbcd 100644
--- a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs
+++ b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs
@@ -344,6 +344,7 @@ bigNatCompareWord a (W# b) = bigNatCompareWord# a b
-- | Compare two BigNat
bigNatCompare :: BigNat# -> BigNat# -> Ordering
+{-# NOINLINE bigNatCompare #-}
bigNatCompare a b =
let
szA = wordArraySize# a
diff --git a/libraries/ghc-bignum/src/GHC/Num/Natural.hs b/libraries/ghc-bignum/src/GHC/Num/Natural.hs
index 3fe09a0625..a494ccee70 100644
--- a/libraries/ghc-bignum/src/GHC/Num/Natural.hs
+++ b/libraries/ghc-bignum/src/GHC/Num/Natural.hs
@@ -162,7 +162,6 @@ naturalNe !x !y = isTrue# (naturalNe# x y)
-- | Greater or equal test for Natural
naturalGe# :: Natural -> Natural -> Bool#
-{-# NOINLINE naturalGe# #-}
naturalGe# (NS x) (NS y) = x `geWord#` y
naturalGe# (NS _) (NB _) = 0#
naturalGe# (NB _) (NS _) = 1#
@@ -174,7 +173,6 @@ naturalGe !x !y = isTrue# (naturalGe# x y)
-- | Lower or equal test for Natural
naturalLe# :: Natural -> Natural -> Bool#
-{-# NOINLINE naturalLe# #-}
naturalLe# (NS x) (NS y) = x `leWord#` y
naturalLe# (NS _) (NB _) = 1#
naturalLe# (NB _) (NS _) = 0#
@@ -187,7 +185,6 @@ naturalLe !x !y = isTrue# (naturalLe# x y)
-- | Greater test for Natural
naturalGt# :: Natural -> Natural -> Bool#
-{-# NOINLINE naturalGt# #-}
naturalGt# (NS x) (NS y) = x `gtWord#` y
naturalGt# (NS _) (NB _) = 0#
naturalGt# (NB _) (NS _) = 1#
@@ -199,7 +196,6 @@ naturalGt !x !y = isTrue# (naturalGt# x y)
-- | Lower test for Natural
naturalLt# :: Natural -> Natural -> Bool#
-{-# NOINLINE naturalLt# #-}
naturalLt# (NS x) (NS y) = x `ltWord#` y
naturalLt# (NS _) (NB _) = 1#
naturalLt# (NB _) (NS _) = 0#
@@ -211,7 +207,6 @@ naturalLt !x !y = isTrue# (naturalLt# x y)
-- | Compare two Natural
naturalCompare :: Natural -> Natural -> Ordering
-{-# NOINLINE naturalCompare #-}
naturalCompare (NS x) (NS y) = cmpW# x y
naturalCompare (NB x) (NB y) = bigNatCompare x y
naturalCompare (NS _) (NB _) = LT