diff options
author | Simon Jakobi <simon.jakobi@gmail.com> | 2022-03-06 00:13:33 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-03-07 14:07:28 -0500 |
commit | 5874a30af459892454cf696f5e6ca913b7f400cc (patch) | |
tree | bbd5bcf64e46ddfea8673465873e9ea7261adab8 /libraries | |
parent | 273bc133a2f4d43be63dcfcf645e697d6fae8178 (diff) | |
download | haskell-5874a30af459892454cf696f5e6ca913b7f400cc.tar.gz |
Improve setBit for Natural
Previously the default definition was used, which involved allocating
intermediate Natural values.
Fixes #21173.
Diffstat (limited to 'libraries')
-rw-r--r-- | libraries/base/GHC/Bits.hs | 1 | ||||
-rw-r--r-- | libraries/ghc-bignum/changelog.md | 1 | ||||
-rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/BigNat.hs | 1 | ||||
-rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/Natural.hs | 11 |
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 #-} |