[commit: ghc] master: integer-gmp: optimise bitBigNat (c7f0626)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/c7f0626699998fe16871fd442e4199b48cbefb35/ghc

>---------------------------------------------------------------

commit c7f0626699998fe16871fd442e4199b48cbefb35
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date:   Sat Aug 29 12:25:45 2015 +0200

    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


>---------------------------------------------------------------

c7f0626699998fe16871fd442e4199b48cbefb35
 libraries/integer-gmp/src/GHC/Integer/Type.hs | 19 ++++++++++++++++++-
 1 file changed, 18 insertions(+), 1 deletion(-)

diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs
index a04d9ad..fd7901a 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#