summaryrefslogtreecommitdiff
path: root/libraries/integer-gmp/src/GHC
diff options
context:
space:
mode:
authorHerbert Valerio Riedel <hvr@gnu.org>2015-08-29 12:25:45 +0200
committerBen Gamari <ben@smart-cactus.org>2015-08-29 13:08:18 +0200
commitc7f0626699998fe16871fd442e4199b48cbefb35 (patch)
treef96a583647b14d05b3645a861a10fd75cb4fdc92 /libraries/integer-gmp/src/GHC
parentcd2dc9e2cf80881e96b98d025c2848edeca11ba4 (diff)
downloadhaskell-c7f0626699998fe16871fd442e4199b48cbefb35.tar.gz
integer-gmp: optimise bitBigNat
This is a somewhat minor optimisation exploiting the static knowledge of the operands involved allowing to save a few allocations. Reviewers: austin, rwbarton, goldfire, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1179
Diffstat (limited to 'libraries/integer-gmp/src/GHC')
-rw-r--r--libraries/integer-gmp/src/GHC/Integer/Type.hs19
1 files changed, 18 insertions, 1 deletions
diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs
index a04d9ad895..fd7901a6c9 100644
--- a/libraries/integer-gmp/src/GHC/Integer/Type.hs
+++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs
@@ -1014,8 +1014,25 @@ timesBigNatWord x@(BN# x#) y#
where
nx# = sizeofBigNat# x
+-- | Specialised version of
+--
+-- > bitBigNat = shiftLBigNat (wordToBigNat 1##)
+--
+-- avoiding a few redundant allocations
bitBigNat :: Int# -> BigNat
-bitBigNat i# = shiftLBigNat (wordToBigNat 1##) i# -- FIXME
+bitBigNat i#
+ | isTrue# (i# <# 0#) = zeroBigNat -- or maybe 'nullBigNat'?
+ | isTrue# (i# ==# 0#) = oneBigNat
+ | True = runS $ do
+ mbn@(MBN# mba#) <- newBigNat# (li# +# 1#)
+ -- FIXME: do we really need to zero-init MBAs returned by 'newByteArray#'?
+ -- clear all limbs (except for the most-significant limb)
+ _ <- svoid (setByteArray# mba# 0# (li# `uncheckedIShiftL#` GMP_LIMB_SHIFT#) 0#)
+ -- set single bit in most-significant limb
+ _ <- svoid (writeBigNat# mbn li# (uncheckedShiftL# 1## bi#))
+ unsafeFreezeBigNat# mbn
+ where
+ (# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS#
testBitBigNat :: BigNat -> Int# -> Bool
testBitBigNat bn i#