[Guile-commits] 10/69: Implement ceiling-divide with new integer lib

[Andy Wingo]

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

commit 3277703d9deeccc1bc84078564d70ee7eb4512c7
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Mon Dec 13 09:19:53 2021 +0100

    Implement ceiling-divide with new integer lib
    
    * libguile/integers.c (scm_integer_ceiling_divide_ii)
    (scm_integer_ceiling_divide_iz, scm_integer_ceiling_divide_zi)
    (scm_integer_ceiling_divide_zz): New internal functions.
    * libguile/integers.h: Declare internal functions.
    * libguile/numbers.c (scm_ceiling_divide): Use the new functions.
---
 libguile/integers.c | 146 ++++++++++++++++++++++++++++++++++++++++++++++------
 libguile/integers.h |   9 ++++
 libguile/numbers.c  | 115 +++--------------------------------------
 3 files changed, 146 insertions(+), 124 deletions(-)

diff --git a/libguile/integers.c b/libguile/integers.c
index eee09797e..1d2254745 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -250,7 +250,7 @@ normalize_bignum (struct scm_bignum *z)
 }
 
 static SCM
-take_bignum_from_mpz (mpz_ptr mpz)
+take_mpz (mpz_ptr mpz)
 {
   struct scm_bignum *res = make_bignum_from_mpz (mpz);
   mpz_clear (mpz);
@@ -358,7 +358,7 @@ scm_integer_floor_quotient_zi (SCM x, scm_t_inum y)
       mpz_neg (q, q);
     }
   scm_remember_upto_here_1 (x);
-  return take_bignum_from_mpz (q);
+  return take_mpz (q);
 }
 
 SCM
@@ -370,7 +370,7 @@ scm_integer_floor_quotient_zz (SCM x, SCM y)
   mpz_init (q);
   mpz_fdiv_q (q, zx, zy);
   scm_remember_upto_here_2 (x, y);
-  return take_bignum_from_mpz (q);
+  return take_mpz (q);
 }
 
 SCM
@@ -397,7 +397,7 @@ scm_integer_floor_remainder_iz (scm_t_inum x, SCM y)
           alias_bignum_to_mpz (scm_bignum (y), zy);
           mpz_sub_ui (r, zy, -x);
           scm_remember_upto_here_1 (y);
-          return take_bignum_from_mpz (r);
+          return take_mpz (r);
         }
       else
         return SCM_I_MAKINUM (x);
@@ -411,7 +411,7 @@ scm_integer_floor_remainder_iz (scm_t_inum x, SCM y)
       alias_bignum_to_mpz (scm_bignum (y), zy);
       mpz_add_ui (r, zy, x);
       scm_remember_upto_here_1 (y);
-      return take_bignum_from_mpz (r);
+      return take_mpz (r);
     }
 }
 
@@ -443,7 +443,7 @@ scm_integer_floor_remainder_zz (SCM x, SCM y)
   mpz_init (r);
   mpz_fdiv_r (r, zx, zy);
   scm_remember_upto_here_2 (x, y);
-  return take_bignum_from_mpz (r);
+  return take_mpz (r);
 }
 
 void
@@ -479,7 +479,7 @@ scm_integer_floor_divide_iz (scm_t_inum x, SCM y, SCM *qp, 
SCM *rp)
           mpz_sub_ui (r, zy, -x);
           scm_remember_upto_here_1 (y);
           *qp = SCM_I_MAKINUM (-1);
-          *rp = take_bignum_from_mpz (r);
+          *rp = take_mpz (r);
         }
       else
         {
@@ -500,7 +500,7 @@ scm_integer_floor_divide_iz (scm_t_inum x, SCM y, SCM *qp, 
SCM *rp)
       mpz_add_ui (r, zy, x);
       scm_remember_upto_here_1 (y);
       *qp = SCM_I_MAKINUM (-1);
-      *rp = take_bignum_from_mpz (r);
+      *rp = take_mpz (r);
     }
 }
 
@@ -522,8 +522,8 @@ scm_integer_floor_divide_zi (SCM x, scm_t_inum y, SCM *qp, 
SCM *rp)
       mpz_neg (q, q);
     }
   scm_remember_upto_here_1 (x);
-  *qp = take_bignum_from_mpz (q);
-  *rp = take_bignum_from_mpz (r);
+  *qp = take_mpz (q);
+  *rp = take_mpz (r);
 }
 
 void
@@ -536,8 +536,8 @@ scm_integer_floor_divide_zz (SCM x, SCM y, SCM *qp, SCM *rp)
   alias_bignum_to_mpz (scm_bignum (y), zy);
   mpz_fdiv_qr (q, r, zx, zy);
   scm_remember_upto_here_2 (x, y);
-  *qp = take_bignum_from_mpz (q);
-  *rp = take_bignum_from_mpz (r);
+  *qp = take_mpz (q);
+  *rp = take_mpz (r);
 }
 
 SCM
@@ -601,7 +601,7 @@ scm_integer_ceiling_quotient_zi (SCM x, scm_t_inum y)
           mpz_neg (q, q);
         }
       scm_remember_upto_here_1 (x);
-      return take_bignum_from_mpz (q);
+      return take_mpz (q);
     }
 }
 
@@ -614,7 +614,7 @@ scm_integer_ceiling_quotient_zz (SCM x, SCM y)
   alias_bignum_to_mpz (scm_bignum (y), zy);
   mpz_cdiv_q (q, zx, zy);
   scm_remember_upto_here_2 (x, y);
-  return take_bignum_from_mpz (q);
+  return take_mpz (q);
 }
 
 SCM
@@ -644,7 +644,7 @@ scm_integer_ceiling_remainder_iz (scm_t_inum x, SCM y)
           mpz_sub_ui (r, zy, x);
           scm_remember_upto_here_1 (y);
           mpz_neg (r, r);
-          return take_bignum_from_mpz (r);
+          return take_mpz (r);
         }
       else if (x == SCM_MOST_NEGATIVE_FIXNUM &&
                bignum_cmp_long (scm_bignum (y), -SCM_MOST_NEGATIVE_FIXNUM) == 
0)
@@ -666,7 +666,7 @@ scm_integer_ceiling_remainder_iz (scm_t_inum x, SCM y)
       mpz_add_ui (r, zy, -x);
       scm_remember_upto_here_1 (y);
       mpz_neg (r, r);
-      return take_bignum_from_mpz (r);
+      return take_mpz (r);
     }
 }
 
@@ -698,5 +698,117 @@ scm_integer_ceiling_remainder_zz (SCM x, SCM y)
   alias_bignum_to_mpz (scm_bignum (y), zy);
   mpz_cdiv_r (r, zx, zy);
   scm_remember_upto_here_2 (x, y);
-  return take_bignum_from_mpz (r);
+  return take_mpz (r);
+}
+
+void
+scm_integer_ceiling_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp)
+{
+  if (y == 0)
+    scm_num_overflow ("ceiling-divide");
+  else
+    {
+      scm_t_inum q = x / y;
+      scm_t_inum r = x % y;
+      int needs_adjustment;
+
+      if (y > 0)
+        needs_adjustment = (r > 0);
+      else
+        needs_adjustment = (r < 0);
+
+      if (needs_adjustment)
+        {
+          r -= y;
+          q++;
+        }
+      *qp = long_to_scm (q);
+      *rp = SCM_I_MAKINUM (r);
+    }
+}
+
+void
+scm_integer_ceiling_divide_iz (scm_t_inum x, SCM y, SCM *qp, SCM *rp)
+{
+  if (bignum_is_positive (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);
+          mpz_neg (r, r);
+          *qp = SCM_INUM1;
+          *rp = take_mpz (r);
+        }
+      else 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);
+          *qp = SCM_I_MAKINUM (-1);
+          *rp = SCM_INUM0;
+        }
+      else
+        {
+          *qp = SCM_INUM0;
+          *rp = SCM_I_MAKINUM (x);
+        }
+    }
+  else if (x >= 0)
+    {
+      *qp = SCM_INUM0;
+      *rp = 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);
+      mpz_neg (r, r);
+      *qp = SCM_INUM1;
+      *rp = take_mpz (r);
+    }
+}
+
+void
+scm_integer_ceiling_divide_zi (SCM x, scm_t_inum y, SCM *qp, SCM *rp)
+{
+  if (y == 0)
+    scm_num_overflow ("ceiling-divide");
+  else
+    {
+      mpz_t q, r, zx;
+      mpz_init (q);
+      mpz_init (r);
+      alias_bignum_to_mpz (scm_bignum (x), zx);
+      if (y > 0)
+        mpz_cdiv_qr_ui (q, r, zx, y);
+      else
+        {
+          mpz_fdiv_qr_ui (q, r, zx, -y);
+          mpz_neg (q, q);
+        }
+      scm_remember_upto_here_1 (x);
+      *qp = take_mpz (q);
+      *rp = take_mpz (r);
+    }
+}
+
+void
+scm_integer_ceiling_divide_zz (SCM x, SCM y, SCM *qp, SCM *rp)
+{
+  mpz_t q, r, zx, zy;
+  mpz_init (q);
+  mpz_init (r);
+  alias_bignum_to_mpz (scm_bignum (x), zx);
+  alias_bignum_to_mpz (scm_bignum (y), zy);
+  mpz_cdiv_qr (q, r, zx, zy);
+  scm_remember_upto_here_2 (x, y);
+  *qp = take_mpz (q);
+  *rp = take_mpz (r);
 }
diff --git a/libguile/integers.h b/libguile/integers.h
index acacc7ac1..331f4aec6 100644
--- a/libguile/integers.h
+++ b/libguile/integers.h
@@ -58,6 +58,15 @@ SCM_INTERNAL SCM scm_integer_ceiling_remainder_iz 
(scm_t_inum x, SCM y);
 SCM_INTERNAL SCM scm_integer_ceiling_remainder_zi (SCM x, scm_t_inum y);
 SCM_INTERNAL SCM scm_integer_ceiling_remainder_zz (SCM x, SCM y);
 
+SCM_INTERNAL void scm_integer_ceiling_divide_ii (scm_t_inum x, scm_t_inum y,
+                                                 SCM *qp, SCM *rp);
+SCM_INTERNAL void scm_integer_ceiling_divide_iz (scm_t_inum x, SCM y,
+                                                 SCM *qp, SCM *rp);
+SCM_INTERNAL void scm_integer_ceiling_divide_zi (SCM x, scm_t_inum y,
+                                                 SCM *qp, SCM *rp);
+SCM_INTERNAL void scm_integer_ceiling_divide_zz (SCM x, SCM y,
+                                                 SCM *qp, SCM *rp);
+
 
 
 #endif  /* SCM_INTEGERS_H */
diff --git a/libguile/numbers.c b/libguile/numbers.c
index dd532c2fc..2e73bac1d 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -1717,84 +1717,14 @@ SCM_PRIMITIVE_GENERIC (scm_i_ceiling_divide, 
"ceiling/", 2, 0, 0,
 void
 scm_ceiling_divide (SCM x, SCM y, SCM *qp, SCM *rp)
 {
-  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_ceiling_divide);
-         else
-           {
-             scm_t_inum qq = xx / yy;
-             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;
-                 qq++;
-               }
-             if (SCM_LIKELY (SCM_FIXABLE (qq)))
-               *qp = SCM_I_MAKINUM (qq);
-             else
-               *qp = scm_i_inum2big (qq);
-             *rp = SCM_I_MAKINUM (rr);
-           }
-       }
+      if (SCM_I_INUMP (y))
+        scm_integer_ceiling_divide_ii (SCM_I_INUM (x), SCM_I_INUM (y), qp, rp);
       else if (SCM_BIGP (y))
-       {
-         int sign = mpz_sgn (SCM_I_BIG_MPZ (y));
-         scm_remember_upto_here_1 (y);
-         if (SCM_LIKELY (sign > 0))
-           {
-             if (SCM_LIKELY (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);
-                 mpz_neg (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r));
-                 *qp = SCM_INUM1;
-                 *rp = scm_i_normbig (r);
-               }
-             else 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);
-                 *qp = SCM_I_MAKINUM (-1);
-                 *rp = SCM_INUM0;
-               }
-             else
-               {
-                 *qp = SCM_INUM0;
-                 *rp = x;
-               }
-           }
-         else if (xx >= 0)
-           {
-             *qp = SCM_INUM0;
-             *rp = 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);
-             mpz_neg (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r));
-             *qp = SCM_INUM1;
-             *rp = scm_i_normbig (r);
-           }
-       }
+        scm_integer_ceiling_divide_iz (SCM_I_INUM (x), y, qp, rp);
       else if (SCM_REALP (y))
-       scm_i_inexact_ceiling_divide (xx, SCM_REAL_VALUE (y), qp, rp);
+       scm_i_inexact_ceiling_divide (SCM_I_INUM (x), SCM_REAL_VALUE (y), qp, 
rp);
       else if (SCM_FRACTIONP (y))
        scm_i_exact_rational_ceiling_divide (x, y, qp, rp);
       else
@@ -1803,39 +1733,10 @@ scm_ceiling_divide (SCM x, SCM y, SCM *qp, SCM *rp)
     }
   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_ceiling_divide);
-         else
-           {
-             SCM q = scm_i_mkbig ();
-             SCM r = scm_i_mkbig ();
-             if (yy > 0)
-               mpz_cdiv_qr_ui (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (r),
-                               SCM_I_BIG_MPZ (x), yy);
-             else
-               {
-                 mpz_fdiv_qr_ui (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (r),
-                                 SCM_I_BIG_MPZ (x), -yy);
-                 mpz_neg (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (q));
-               }
-             scm_remember_upto_here_1 (x);
-             *qp = scm_i_normbig (q);
-             *rp = scm_i_normbig (r);
-           }
-       }
+      if (SCM_I_INUMP (y))
+        scm_integer_ceiling_divide_zi (x, SCM_I_INUM (y), qp, rp);
       else if (SCM_BIGP (y))
-       {
-         SCM q = scm_i_mkbig ();
-         SCM r = scm_i_mkbig ();
-         mpz_cdiv_qr (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (r),
-                      SCM_I_BIG_MPZ (x), SCM_I_BIG_MPZ (y));
-         scm_remember_upto_here_2 (x, y);
-         *qp = scm_i_normbig (q);
-         *rp = scm_i_normbig (r);
-       }
+        scm_integer_ceiling_divide_zz (x, y, qp, rp);
       else if (SCM_REALP (y))
        scm_i_inexact_ceiling_divide (scm_i_big2dbl (x), SCM_REAL_VALUE (y),
                                       qp, rp);