[Guile-commits] 12/69: Implement truncate-remainder with new integer lib

[Andy Wingo]

wingo pushed a commit to branch wip-inline-digits
in repository guile.

commit cfa926a477503c3400f191ea7e664fa1e18c1748
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Mon Dec 13 09:50:14 2021 +0100

    Implement truncate-remainder with new integer lib
    
    * libguile/integers.c (scm_integer_truncate_remainder_ii)
    (scm_integer_truncate_remainder_iz, scm_integer_truncate_remainder_zi)
    (scm_integer_truncate_remainder_zz): New internal functions.
    * libguile/integers.h: Declare internal functions.
    * libguile/numbers.c (scm_truncate_remainder): Use the new functions.
---
 libguile/integers.c | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++
 libguile/integers.h |  5 +++++
 libguile/numbers.c  | 55 ++++++++++-------------------------------------------
 3 files changed, 68 insertions(+), 45 deletions(-)

diff --git a/libguile/integers.c b/libguile/integers.c
index 5653fa8d2..0d2bfb238 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -874,3 +874,56 @@ scm_integer_truncate_quotient_zz (SCM x, SCM y)
   scm_remember_upto_here_2 (x, y);
   return take_mpz (q);
 }
+
+SCM
+scm_integer_truncate_remainder_ii (scm_t_inum x, scm_t_inum y)
+{
+  if (y == 0)
+    scm_num_overflow ("truncate-remainder");
+  else
+    {
+      scm_t_inum q = x % y;
+      return long_to_scm (q);
+    }
+}
+
+SCM
+scm_integer_truncate_remainder_iz (scm_t_inum x, SCM y)
+{
+  if (x == SCM_MOST_NEGATIVE_FIXNUM &&
+      bignum_cmp_long (scm_bignum (y), -SCM_MOST_NEGATIVE_FIXNUM) == 0)
+    {
+      /* Special case: x == fixnum-min && y == abs (fixnum-min) */
+      scm_remember_upto_here_1 (y);
+      return SCM_INUM0;
+    }
+  else
+    return SCM_I_MAKINUM (x);
+}
+
+SCM
+scm_integer_truncate_remainder_zi (SCM x, scm_t_inum y)
+{
+  if (y == 0)
+    scm_num_overflow ("truncate-remainder");
+  else
+    {
+      mpz_t zx;
+      alias_bignum_to_mpz (scm_bignum (x), zx);
+      scm_t_inum r = mpz_tdiv_ui (zx, (y > 0) ? y : -y) * mpz_sgn (zx);
+      scm_remember_upto_here_1 (x);
+      return SCM_I_MAKINUM (r);
+    }
+}
+
+SCM
+scm_integer_truncate_remainder_zz (SCM x, SCM y)
+{
+  mpz_t r, zx, zy;
+  mpz_init (r);
+  alias_bignum_to_mpz (scm_bignum (x), zx);
+  alias_bignum_to_mpz (scm_bignum (y), zy);
+  mpz_tdiv_r (r, zx, zy);
+  scm_remember_upto_here_2 (x, y);
+  return take_mpz (r);
+}
diff --git a/libguile/integers.h b/libguile/integers.h
index 9707444f7..9b6d8b5d2 100644
--- a/libguile/integers.h
+++ b/libguile/integers.h
@@ -72,6 +72,11 @@ SCM_INTERNAL SCM scm_integer_truncate_quotient_iz 
(scm_t_inum x, SCM y);
 SCM_INTERNAL SCM scm_integer_truncate_quotient_zi (SCM x, scm_t_inum y);
 SCM_INTERNAL SCM scm_integer_truncate_quotient_zz (SCM x, SCM y);
 
+SCM_INTERNAL SCM scm_integer_truncate_remainder_ii (scm_t_inum x, scm_t_inum 
y);
+SCM_INTERNAL SCM scm_integer_truncate_remainder_iz (scm_t_inum x, SCM y);
+SCM_INTERNAL SCM scm_integer_truncate_remainder_zi (SCM x, scm_t_inum y);
+SCM_INTERNAL SCM scm_integer_truncate_remainder_zz (SCM x, SCM y);
+
 
 
 #endif  /* SCM_INTEGERS_H */
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 7abc727d7..e59784543 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -1908,32 +1908,16 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder, 
"truncate-remainder", 2, 0, 0,
                       "@end lisp")
 #define FUNC_NAME s_scm_truncate_remainder
 {
-  if (SCM_LIKELY (SCM_I_INUMP (x)))
+  if (SCM_I_INUMP (x))
     {
-      scm_t_inum xx = SCM_I_INUM (x);
-      if (SCM_LIKELY (SCM_I_INUMP (y)))
-       {
-         scm_t_inum yy = SCM_I_INUM (y);
-         if (SCM_UNLIKELY (yy == 0))
-           scm_num_overflow (s_scm_truncate_remainder);
-         else
-           return SCM_I_MAKINUM (xx % yy);
-       }
+      if (SCM_I_INUMP (y))
+        return scm_integer_truncate_remainder_ii (SCM_I_INUM (x),
+                                                  SCM_I_INUM (y));
       else if (SCM_BIGP (y))
-       {
-         if (SCM_UNLIKELY (xx == SCM_MOST_NEGATIVE_FIXNUM)
-             && SCM_UNLIKELY (mpz_cmp_ui (SCM_I_BIG_MPZ (y),
-                                          - SCM_MOST_NEGATIVE_FIXNUM) == 0))
-           {
-             /* Special case: x == fixnum-min && y == abs (fixnum-min) */
-             scm_remember_upto_here_1 (y);
-             return SCM_INUM0;
-           }
-         else
-           return x;
-       }
+        return scm_integer_truncate_remainder_iz (SCM_I_INUM (x), y);
       else if (SCM_REALP (y))
-       return scm_i_inexact_truncate_remainder (xx, SCM_REAL_VALUE (y));
+       return scm_i_inexact_truncate_remainder (SCM_I_INUM (x),
+                                                 SCM_REAL_VALUE (y));
       else if (SCM_FRACTIONP (y))
        return scm_i_exact_rational_truncate_remainder (x, y);
       else
@@ -1942,29 +1926,10 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder, 
"truncate-remainder", 2, 0, 0,
     }
   else if (SCM_BIGP (x))
     {
-      if (SCM_LIKELY (SCM_I_INUMP (y)))
-       {
-         scm_t_inum yy = SCM_I_INUM (y);
-         if (SCM_UNLIKELY (yy == 0))
-           scm_num_overflow (s_scm_truncate_remainder);
-         else
-           {
-             scm_t_inum rr = (mpz_tdiv_ui (SCM_I_BIG_MPZ (x),
-                                           (yy > 0) ? yy : -yy)
-                              * mpz_sgn (SCM_I_BIG_MPZ (x)));
-             scm_remember_upto_here_1 (x);
-             return SCM_I_MAKINUM (rr);
-           }
-       }
+      if (SCM_I_INUMP (y))
+        return scm_integer_truncate_remainder_zi (x, SCM_I_INUM (y));
       else if (SCM_BIGP (y))
-       {
-         SCM r = scm_i_mkbig ();
-         mpz_tdiv_r (SCM_I_BIG_MPZ (r),
-                     SCM_I_BIG_MPZ (x),
-                     SCM_I_BIG_MPZ (y));
-         scm_remember_upto_here_2 (x, y);
-         return scm_i_normbig (r);
-       }
+        return scm_integer_truncate_remainder_zz (x, y);
       else if (SCM_REALP (y))
        return scm_i_inexact_truncate_remainder
          (scm_i_big2dbl (x), SCM_REAL_VALUE (y));