[Guile-commits] 05/69: Implement floor-quotient with new integer lib

[Andy Wingo]

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

commit 4104cc0f04691c0e4131fecd3fc41621fb1a27de
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Fri Dec 3 22:34:09 2021 +0100

    Implement floor-quotient with new integer lib
    
    * libguile/integers.c (scm_integer_floor_quotient_ii)
    (scm_integer_floor_quotient_iz, scm_integer_floor_quotient_zi)
    (scm_integer_floor_quotient_zz): New internal functions.
    (long_to_scm, ulong_to_scm, take_bignum_from_mpz): New helpers.
    * libguile/integers.h: Declare internal functions.
    * libguile/numbers.c (scm_floor_quotient): Use the new functions.
---
 libguile/integers.c | 86 ++++++++++++++++++++++++++++++++++++++++++++++++-----
 libguile/integers.h |  5 ++++
 libguile/numbers.c  | 68 +++++-------------------------------------
 3 files changed, 92 insertions(+), 67 deletions(-)

diff --git a/libguile/integers.c b/libguile/integers.c
index 34a1d4af8..87483a73f 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -180,10 +180,20 @@ long_to_bignum (long i)
 };
 
 static SCM
-inum_to_bignum (scm_t_inum i)
+long_to_scm (long i)
 {
+  if (SCM_FIXABLE (i))
+    return SCM_I_MAKINUM (i);
   return long_to_bignum (i);
-};
+}
+
+static SCM
+ulong_to_scm (unsigned long i)
+{
+  if (SCM_POSFIXABLE (i))
+    return SCM_I_MAKINUM (i);
+  return ulong_to_bignum (i);
+}
 
 static struct scm_bignum *
 clone_bignum (struct scm_bignum *z)
@@ -212,6 +222,14 @@ make_bignum_from_mpz (mpz_srcptr mpz)
   return mpz_sgn (mpz) < 0 ? negate_bignum (ret) : ret;
 }
 
+static struct scm_bignum *
+take_bignum_from_mpz (mpz_ptr mpz)
+{
+  struct scm_bignum *res = make_bignum_from_mpz (mpz);
+  mpz_clear (mpz);
+  return res;
+}
+
 static SCM
 normalize_bignum (struct scm_bignum *z)
 {
@@ -251,11 +269,7 @@ scm_integer_abs_i (scm_t_inum i)
   if (i >= 0)
     return SCM_I_MAKINUM (i);
 
-  unsigned long abs = long_magnitude (i);
-  if (SCM_LIKELY (SCM_POSFIXABLE (abs)))
-    return SCM_I_MAKINUM (abs);
-
-  return ulong_to_bignum (abs);
+  return ulong_to_scm (long_magnitude (i));
 }
 
 SCM
@@ -266,3 +280,61 @@ scm_integer_abs_z (SCM z)
 
   return SCM_PACK (negate_bignum (clone_bignum (scm_bignum (z))));
 }
+
+SCM
+scm_integer_floor_quotient_ii (scm_t_inum x, scm_t_inum y)
+{
+  if (y > 0)
+    {
+      if (x < 0)
+        x = x - y + 1;
+    }
+  else if (y == 0)
+    scm_num_overflow ("floor-quotient");
+  else if (x > 0)
+    x = x - y - 1;
+  scm_t_inum q = x / y;
+  return long_to_scm (q);
+}
+
+SCM
+scm_integer_floor_quotient_iz (scm_t_inum x, SCM y)
+{
+  if (x == 0 || ((x < 0) == bignum_is_negative (scm_bignum (y))))
+    return SCM_INUM0;
+  return SCM_I_MAKINUM (-1);
+}
+ 
+SCM
+scm_integer_floor_quotient_zi (SCM x, scm_t_inum y)
+{
+  if (y == 0)
+    scm_num_overflow ("floor-quotient");
+  else if (y == 1)
+    return x;
+
+  mpz_t zx, q;
+  alias_bignum_to_mpz (scm_bignum (x), zx);
+  mpz_init (q);
+  if (y > 0)
+    mpz_fdiv_q_ui (q, zx, y);
+  else
+    {
+      mpz_cdiv_q_ui (q, zx, -y);
+      mpz_neg (q, q);
+    }
+  scm_remember_upto_here_1 (x);
+  return SCM_PACK (normalize_bignum (take_bignum_from_mpz (q)));
+}
+
+SCM
+scm_integer_floor_quotient_zz (SCM x, SCM y)
+{
+  mpz_t zx, zy, q;
+  alias_bignum_to_mpz (scm_bignum (x), zx);
+  alias_bignum_to_mpz (scm_bignum (y), zy);
+  mpz_init (q);
+  mpz_fdiv_q (q, zx, zy);
+  scm_remember_upto_here_2 (x, y);
+  return SCM_PACK (normalize_bignum (take_bignum_from_mpz (q)));
+}
diff --git a/libguile/integers.h b/libguile/integers.h
index 753ff1f74..99e4246cd 100644
--- a/libguile/integers.h
+++ b/libguile/integers.h
@@ -29,6 +29,11 @@ SCM_INTERNAL int scm_is_integer_odd_z (SCM z);
 SCM_INTERNAL SCM scm_integer_abs_i (scm_t_inum i);
 SCM_INTERNAL SCM scm_integer_abs_z (SCM z);
 
+SCM_INTERNAL SCM scm_integer_floor_quotient_ii (scm_t_inum x, scm_t_inum y);
+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);
+
 
 
 #endif  /* SCM_INTEGERS_H */
diff --git a/libguile/numbers.c b/libguile/numbers.c
index ea0cf67bb..d79ee214b 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -1200,40 +1200,14 @@ SCM_PRIMITIVE_GENERIC (scm_floor_quotient, 
"floor-quotient", 2, 0, 0,
                       "@end lisp")
 #define FUNC_NAME s_scm_floor_quotient
 {
-  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);
-         scm_t_inum xx1 = xx;
-         scm_t_inum qq;
-         if (SCM_LIKELY (yy > 0))
-           {
-             if (SCM_UNLIKELY (xx < 0))
-               xx1 = xx - yy + 1;
-           }
-         else if (SCM_UNLIKELY (yy == 0))
-           scm_num_overflow (s_scm_floor_quotient);
-         else if (xx > 0)
-           xx1 = xx - yy - 1;
-         qq = xx1 / yy;
-         if (SCM_LIKELY (SCM_FIXABLE (qq)))
-           return SCM_I_MAKINUM (qq);
-         else
-           return scm_i_inum2big (qq);
-       }
+      if (SCM_I_INUMP (y))
+        return scm_integer_floor_quotient_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)
-           return SCM_I_MAKINUM ((xx < 0) ? -1 : 0);
-         else
-           return SCM_I_MAKINUM ((xx > 0) ? -1 : 0);
-       }
+        return scm_integer_floor_quotient_iz (SCM_I_INUM (x), y);
       else if (SCM_REALP (y))
-       return scm_i_inexact_floor_quotient (xx, SCM_REAL_VALUE (y));
+       return scm_i_inexact_floor_quotient (SCM_I_INUM (x), SCM_REAL_VALUE 
(y));
       else if (SCM_FRACTIONP (y))
        return scm_i_exact_rational_floor_quotient (x, y);
       else
@@ -1242,36 +1216,10 @@ SCM_PRIMITIVE_GENERIC (scm_floor_quotient, 
"floor-quotient", 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_quotient);
-         else if (SCM_UNLIKELY (yy == 1))
-           return x;
-         else
-           {
-             SCM q = scm_i_mkbig ();
-             if (yy > 0)
-               mpz_fdiv_q_ui (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (x), yy);
-             else
-               {
-                 mpz_cdiv_q_ui (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (x), -yy);
-                 mpz_neg (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (q));
-               }
-             scm_remember_upto_here_1 (x);
-             return scm_i_normbig (q);
-           }
-       }
+      if (SCM_I_INUMP (y))
+        return scm_integer_floor_quotient_zi (x, SCM_I_INUM (y));
       else if (SCM_BIGP (y))
-       {
-         SCM q = scm_i_mkbig ();
-         mpz_fdiv_q (SCM_I_BIG_MPZ (q),
-                     SCM_I_BIG_MPZ (x),
-                     SCM_I_BIG_MPZ (y));
-         scm_remember_upto_here_2 (x, y);
-         return scm_i_normbig (q);
-       }
+        return scm_integer_floor_quotient_zz (x, y);
       else if (SCM_REALP (y))
        return scm_i_inexact_floor_quotient
          (scm_i_big2dbl (x), SCM_REAL_VALUE (y));