[commit: packages/integer-gmp] wip/T8638: Add new `mpz_mul_si`-based primop (14d9702)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/integer-gmp

On branch  : wip/T8638
Link       : http://git.haskell.org/packages/integer-gmp.git/commitdiff/14d97025d9e95b6d1ff04a0ed63caf9e2c02fe08

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

commit 14d97025d9e95b6d1ff04a0ed63caf9e2c02fe08
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date:   Thu Jan 2 09:31:50 2014 +0100

    Add new `mpz_mul_si`-based primop
    
    This primop helps reducing allocation by being able to pass one `S#`
    argument directly to the GMP multiplication primitive without needing to
    promote (and thus allocate a `ByteArray#` as well) the `J#` first.
    
    This benefits a few nofib benchmarks wrt to allocations (having most
    impact on `kahan` resulting in about 10% less allocations)
    
    Signed-off-by: Herbert Valerio Riedel <hvr at gnu.org>


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

14d97025d9e95b6d1ff04a0ed63caf9e2c02fe08
 GHC/Integer/GMP/Prim.hs |    6 ++++++
 GHC/Integer/Type.lhs    |   11 +++++++----
 cbits/gmp-wrappers.cmm  |    2 ++
 3 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/GHC/Integer/GMP/Prim.hs b/GHC/Integer/GMP/Prim.hs
index 0fd1b37..3958f13 100644
--- a/GHC/Integer/GMP/Prim.hs
+++ b/GHC/Integer/GMP/Prim.hs
@@ -10,6 +10,7 @@ module GHC.Integer.GMP.Prim (
     plusInteger#,
     minusInteger#,
     timesInteger#,
+    timesIntegerInt#,
 
     quotRemInteger#,
     quotInteger#,
@@ -97,6 +98,11 @@ foreign import prim "integer_cmm_minusIntegerzh" minusInteger#
 foreign import prim "integer_cmm_timesIntegerzh" timesInteger#
   :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# Int#, ByteArray# #)
 
+-- | Optimized version of 'timesInteger#' for multiplying big-ints with small-ints
+--
+foreign import prim "integer_cmm_timesIntegerIntzh" timesIntegerInt#
+  :: Int# -> ByteArray# -> Int# -> (# Int#, ByteArray# #)
+
 -- | Compute div and mod simultaneously, where div rounds towards negative
 -- infinity and\ @(q,r) = divModInteger#(x,y)@ implies
 -- @plusInteger# (timesInteger# q y) r = x at .
diff --git a/GHC/Integer/Type.lhs b/GHC/Integer/Type.lhs
index a64f157..5c6919c 100644
--- a/GHC/Integer/Type.lhs
+++ b/GHC/Integer/Type.lhs
@@ -38,7 +38,7 @@ import GHC.Prim (
 import GHC.Integer.GMP.Prim (
     -- GMP-related primitives
     cmpInteger#, cmpIntegerInt#,
-    plusInteger#, minusInteger#, timesInteger#,
+    plusInteger#, minusInteger#, timesInteger#, timesIntegerInt#,
     quotRemInteger#, quotInteger#, remInteger#,
     divModInteger#, divInteger#, modInteger#,
     gcdInteger#, gcdExtInteger#, gcdIntegerInt#, gcdInt#, divExactInteger#,
@@ -529,13 +529,16 @@ minusInteger (J# s1 d1) (J# s2 d2) = case minusInteger# s1 d1 s2 d2 of
 
 {-# NOINLINE timesInteger #-}
 timesInteger :: Integer -> Integer -> Integer
-timesInteger i1@(S# i) i2@(S# j)   = if isTrue# (mulIntMayOflo# i j ==# 0#)
+timesInteger (S# i) (S# j)         = if isTrue# (mulIntMayOflo# i j ==# 0#)
                                      then S# (i *# j)
-                                     else timesInteger (toBig i1) (toBig i2)
+                                     else case int2Integer# i of
+                                          (# s, d #) -> case timesIntegerInt# s d j of
+                                                        (# s', d' #) -> smartJ# s' d'
 timesInteger (S# 0#)     _         = S# 0#
 timesInteger (S# -1#)    i2        = negateInteger i2
 timesInteger (S# 1#)     i2        = i2
-timesInteger i1@(S# _) i2@(J# _ _) = timesInteger (toBig i1) i2
+timesInteger (S# i1)    (J# s2 d2) = case timesIntegerInt# s2 d2 i1 of
+                                     (# s, d #) -> J# s d
 timesInteger i1@(J# _ _) i2@(S# _) = timesInteger i2 i1 -- swap args & retry
 timesInteger (J# s1 d1) (J# s2 d2) = case timesInteger# s1 d1 s2 d2 of
                                      (# s, d #) -> J# s d
diff --git a/cbits/gmp-wrappers.cmm b/cbits/gmp-wrappers.cmm
index 47a333c..39b6fba 100644
--- a/cbits/gmp-wrappers.cmm
+++ b/cbits/gmp-wrappers.cmm
@@ -33,6 +33,7 @@ import "integer-gmp" __gmpz_add;
 import "integer-gmp" __gmpz_sub;
 import "integer-gmp" __gmpz_mul;
 import "integer-gmp" __gmpz_mul_2exp;
+import "integer-gmp" __gmpz_mul_si;
 import "integer-gmp" __gmpz_tstbit;
 import "integer-gmp" __gmpz_fdiv_q_2exp;
 import "integer-gmp" __gmpz_gcd;
@@ -488,6 +489,7 @@ again:                                                                  \
 GMP_TAKE2_RET1(integer_cmm_plusIntegerzh,           __gmpz_add)
 GMP_TAKE2_RET1(integer_cmm_minusIntegerzh,          __gmpz_sub)
 GMP_TAKE2_RET1(integer_cmm_timesIntegerzh,          __gmpz_mul)
+GMP_TAKE1_UL1_RET1(integer_cmm_timesIntegerIntzh,   __gmpz_mul_si)
 GMP_TAKE2_RET1(integer_cmm_gcdIntegerzh,            __gmpz_gcd)
 #define CMM_GMPZ_GCDEXT(g,s,a,b) __gmpz_gcdext(g,s,NULL,a,b)
 GMP_TAKE2_RET2(integer_cmm_gcdExtIntegerzh,         CMM_GMPZ_GCDEXT)