[Guile-commits] 06/69: Implement floor-remainder with new integer lib

[Andy Wingo]

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

commit 69a24ea12c2b60c97c2f1b5e9884f2252c9d2e8d
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Sun Dec 5 22:08:39 2021 +0100

    Implement floor-remainder with new integer lib
    
    * libguile/integers.c (scm_integer_floor_remainder_ii)
    (scm_integer_floor_remainder_iz, scm_integer_floor_remainder_zi)
    (scm_integer_floor_remainder_zz): New internal functions.
    * libguile/integers.h: Declare internal functions.
    * libguile/numbers.c (scm_floor_remainder): Use the new functions.
---
 libguile/integers.c | 73 +++++++++++++++++++++++++++++++++++++++++++++++++
 libguile/integers.h |  5 ++++
 libguile/numbers.c  | 79 ++++++-----------------------------------------------
 3 files changed, 86 insertions(+), 71 deletions(-)

diff --git a/libguile/integers.c b/libguile/integers.c
index 87483a73f..e64d3f946 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -338,3 +338,76 @@ scm_integer_floor_quotient_zz (SCM x, SCM y)
   scm_remember_upto_here_2 (x, y);
   return SCM_PACK (normalize_bignum (take_bignum_from_mpz (q)));
 }
+
+SCM
+scm_integer_floor_remainder_ii (scm_t_inum x, scm_t_inum y)
+{
+  if (y == 0)
+    scm_num_overflow ("floor-remainder");
+  scm_t_inum r = x % y;
+  int needs_adjustment = (y > 0) ? (r < 0) : (r > 0);
+  if (needs_adjustment)
+    r += y;
+  return SCM_I_MAKINUM (r);
+}
+
+SCM
+scm_integer_floor_remainder_iz (scm_t_inum x, SCM y)
+{
+  if (!bignum_is_negative (scm_bignum (y)))
+    {
+      if (x < 0)
+        {
+          mpz_t r, zy;
+          mpz_init (r);
+          alias_bignum_to_mpz (scm_bignum (y), zy);
+          mpz_sub_ui (r, zy, -x);
+          scm_remember_upto_here_1 (y);
+          return SCM_PACK (normalize_bignum (take_bignum_from_mpz (r)));
+        }
+      else
+        return SCM_I_MAKINUM (x);
+    }
+  else if (x <= 0)
+    return SCM_I_MAKINUM (x);
+  else
+    {
+      mpz_t r, zy;
+      mpz_init (r);
+      alias_bignum_to_mpz (scm_bignum (y), zy);
+      mpz_add_ui (r, zy, x);
+      scm_remember_upto_here_1 (y);
+      return SCM_PACK (normalize_bignum (take_bignum_from_mpz (r)));
+    }
+}
+
+SCM
+scm_integer_floor_remainder_zi (SCM x, scm_t_inum y)
+{
+  if (SCM_UNLIKELY (y == 0))
+    scm_num_overflow ("floor-remainder");
+  else
+    {
+      scm_t_inum r;
+      mpz_t zx;
+      alias_bignum_to_mpz (scm_bignum (x), zx);
+      if (y > 0)
+        r = mpz_fdiv_ui (zx, y);
+      else
+        r = -mpz_cdiv_ui (zx, -y);
+      scm_remember_upto_here_1 (x);
+      return SCM_I_MAKINUM (r);
+    }
+}
+
+SCM
+scm_integer_floor_remainder_zz (SCM x, SCM y)
+{
+  mpz_t zx, zy, r;
+  alias_bignum_to_mpz (scm_bignum (x), zx);
+  alias_bignum_to_mpz (scm_bignum (y), zy);
+  mpz_init (r);
+  mpz_fdiv_r (r, zx, zy);
+  scm_remember_upto_here_2 (x, y);
+  return SCM_PACK (normalize_bignum (take_bignum_from_mpz (r)));
+}
diff --git a/libguile/integers.h b/libguile/integers.h
index 99e4246cd..671d32ae3 100644
--- a/libguile/integers.h
+++ b/libguile/integers.h
@@ -34,6 +34,11 @@ SCM_INTERNAL SCM scm_integer_floor_quotient_iz (scm_t_inum 
x, SCM y);
 SCM_INTERNAL SCM scm_integer_floor_quotient_zi (SCM x, scm_t_inum y);
 SCM_INTERNAL SCM scm_integer_floor_quotient_zz (SCM x, SCM y);
 
+SCM_INTERNAL SCM scm_integer_floor_remainder_ii (scm_t_inum x, scm_t_inum y);
+SCM_INTERNAL SCM scm_integer_floor_remainder_iz (scm_t_inum x, SCM y);
+SCM_INTERNAL SCM scm_integer_floor_remainder_zi (SCM x, scm_t_inum y);
+SCM_INTERNAL SCM scm_integer_floor_remainder_zz (SCM x, SCM y);
+
 
 
 #endif  /* SCM_INTEGERS_H */
diff --git a/libguile/numbers.c b/libguile/numbers.c
index d79ee214b..44e021160 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -1293,55 +1293,13 @@ SCM_PRIMITIVE_GENERIC (scm_floor_remainder, 
"floor-remainder", 2, 0, 0,
 {
   if (SCM_LIKELY (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_floor_remainder);
-         else
-           {
-             scm_t_inum rr = xx % yy;
-             int needs_adjustment;
-
-             if (SCM_LIKELY (yy > 0))
-               needs_adjustment = (rr < 0);
-             else
-               needs_adjustment = (rr > 0);
-
-             if (needs_adjustment)
-               rr += yy;
-             return SCM_I_MAKINUM (rr);
-           }
-       }
+      if (SCM_I_INUMP (y))
+        return scm_integer_floor_remainder_ii (SCM_I_INUM (x), SCM_I_INUM (y));
       else if (SCM_BIGP (y))
-       {
-         int sign = mpz_sgn (SCM_I_BIG_MPZ (y));
-         scm_remember_upto_here_1 (y);
-         if (sign > 0)
-           {
-             if (xx < 0)
-               {
-                 SCM r = scm_i_mkbig ();
-                 mpz_sub_ui (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (y), -xx);
-                 scm_remember_upto_here_1 (y);
-                 return scm_i_normbig (r);
-               }
-             else
-               return x;
-           }
-         else if (xx <= 0)
-           return x;
-         else
-           {
-             SCM r = scm_i_mkbig ();
-             mpz_add_ui (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (y), xx);
-             scm_remember_upto_here_1 (y);
-             return scm_i_normbig (r);
-           }
-       }
+        return scm_integer_floor_remainder_iz (SCM_I_INUM (x), y);
       else if (SCM_REALP (y))
-       return scm_i_inexact_floor_remainder (xx, SCM_REAL_VALUE (y));
+       return scm_i_inexact_floor_remainder (SCM_I_INUM (x),
+                                              SCM_REAL_VALUE (y));
       else if (SCM_FRACTIONP (y))
        return scm_i_exact_rational_floor_remainder (x, y);
       else
@@ -1350,31 +1308,10 @@ SCM_PRIMITIVE_GENERIC (scm_floor_remainder, 
"floor-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_floor_remainder);
-         else
-           {
-             scm_t_inum rr;
-             if (yy > 0)
-               rr = mpz_fdiv_ui (SCM_I_BIG_MPZ (x), yy);
-             else
-               rr = -mpz_cdiv_ui (SCM_I_BIG_MPZ (x), -yy);
-             scm_remember_upto_here_1 (x);
-             return SCM_I_MAKINUM (rr);
-           }
-       }
+      if (SCM_I_INUMP (y))
+        return scm_integer_floor_remainder_zi (x, SCM_I_INUM (y));
       else if (SCM_BIGP (y))
-       {
-         SCM r = scm_i_mkbig ();
-         mpz_fdiv_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_floor_remainder_zz (x, y);
       else if (SCM_REALP (y))
        return scm_i_inexact_floor_remainder
          (scm_i_big2dbl (x), SCM_REAL_VALUE (y));