summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Jakobi <simon.jakobi@gmail.com>2022-03-06 00:13:33 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-03-07 14:07:28 -0500
commit5874a30af459892454cf696f5e6ca913b7f400cc (patch)
treebbd5bcf64e46ddfea8673465873e9ea7261adab8
parent273bc133a2f4d43be63dcfcf645e697d6fae8178 (diff)
downloadhaskell-5874a30af459892454cf696f5e6ca913b7f400cc.tar.gz
Improve setBit for Natural
Previously the default definition was used, which involved allocating intermediate Natural values. Fixes #21173.
-rw-r--r--libraries/base/GHC/Bits.hs1
-rw-r--r--libraries/ghc-bignum/changelog.md1
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/BigNat.hs1
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/Natural.hs11
4 files changed, 14 insertions, 0 deletions
diff --git a/libraries/base/GHC/Bits.hs b/libraries/base/GHC/Bits.hs
index e74e8bb6d0..4c3bef2f44 100644
--- a/libraries/base/GHC/Bits.hs
+++ b/libraries/base/GHC/Bits.hs
@@ -583,6 +583,7 @@ instance Bits Natural where
| otherwise = naturalShiftR x (fromIntegral (negate i))
testBit x i = naturalTestBit x (fromIntegral i)
zeroBits = naturalZero
+ setBit x i = naturalSetBit x (fromIntegral i)
clearBit x i = x `xor` (bit i .&. x)
bit (I# i) = naturalBit# (int2Word# i)
diff --git a/libraries/ghc-bignum/changelog.md b/libraries/ghc-bignum/changelog.md
index 015721d40b..d57a6d8a68 100644
--- a/libraries/ghc-bignum/changelog.md
+++ b/libraries/ghc-bignum/changelog.md
@@ -3,6 +3,7 @@
## 1.3
- Expose backendName
+- Add `naturalSetBit[#]` (#21173)
## 1.2
diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs
index 5fa81b7e5b..bab3a97190 100644
--- a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs
+++ b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs
@@ -1045,6 +1045,7 @@ bigNatClearBit# a n
-- | BigNat set bit
bigNatSetBit# :: BigNat# -> Word# -> BigNat#
+{-# NOINLINE bigNatSetBit# #-}
bigNatSetBit# a n
-- check the current bit value
| isTrue# (bigNatTestBit# a n) = a
diff --git a/libraries/ghc-bignum/src/GHC/Num/Natural.hs b/libraries/ghc-bignum/src/GHC/Num/Natural.hs
index 72b646501d..8fe737bf07 100644
--- a/libraries/ghc-bignum/src/GHC/Num/Natural.hs
+++ b/libraries/ghc-bignum/src/GHC/Num/Natural.hs
@@ -421,6 +421,17 @@ naturalBit# i
naturalBit :: Word -> Natural
naturalBit (W# i) = naturalBit# i
+-- | @since 1.3
+naturalSetBit# :: Natural -> Word# -> Natural
+naturalSetBit# (NS n) i
+ | isTrue# (i `ltWord#` WORD_SIZE_IN_BITS##) = NS (n `or#` (1## `uncheckedShiftL#` word2Int# i))
+ | True = NB (bigNatSetBit# (bigNatFromWord# n) i)
+naturalSetBit# (NB n) i = NB (bigNatSetBit# n i)
+
+-- | @since 1.3
+naturalSetBit :: Natural -> Word -> Natural
+naturalSetBit !n (W# i) = naturalSetBit# n i
+
-- | Compute greatest common divisor.
naturalGcd :: Natural -> Natural -> Natural
{-# NOINLINE naturalGcd #-}