Add new `mpz_mul_si`-based primop (re #8647)

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@gnu.org>

3 files changed, 15 insertions, 4 deletions

diff --git a/libraries/integer-gmp/GHC/Integer/GMP/Prim.hs b/libraries/integer-gmp/GHC/Integer/GMP/Prim.hs
index 0fd1b379d8..3958f13d30 100644
--- a/libraries/integer-gmp/GHC/Integer/GMP/Prim.hs
+++ b/libraries/integer-gmp/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@.
diff --git a/libraries/integer-gmp/GHC/Integer/Type.lhs b/libraries/integer-gmp/GHC/Integer/Type.lhs
index a64f157387..5c6919c000 100644
--- a/libraries/integer-gmp/GHC/Integer/Type.lhs
+++ b/libraries/integer-gmp/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/libraries/integer-gmp/cbits/gmp-wrappers.cmm b/libraries/integer-gmp/cbits/gmp-wrappers.cmm
index 47a333cd80..39b6fba3eb 100644
--- a/libraries/integer-gmp/cbits/gmp-wrappers.cmm
+++ b/libraries/integer-gmp/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)