guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 60/85: Simplify scm_exact_integer_quotient


From: Andy Wingo
Subject: [Guile-commits] 60/85: Simplify scm_exact_integer_quotient
Date: Thu, 13 Jan 2022 03:40:23 -0500 (EST)

wingo pushed a commit to branch main
in repository guile.

commit a4524da8c1b5ce6407931e6fab8ffa727370a798
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Fri Jan 7 11:18:48 2022 +0100

    Simplify scm_exact_integer_quotient
    
    * libguile/integers.h:
    * libguile/integers.c (scm_integer_exact_quotient_iz): New internal
    function.
    * libguile/numbers.c (scm_i_make_ratio): Simplify and enforce
    invariants.
    (scm_exact_integer_quotient): Use integer lib.
---
 libguile/integers.c |  14 ++++++++
 libguile/integers.h |   2 ++
 libguile/numbers.c  | 102 +++++++++++++++-------------------------------------
 3 files changed, 44 insertions(+), 74 deletions(-)

diff --git a/libguile/integers.c b/libguile/integers.c
index f8a03266e..f6d33a21c 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -2939,6 +2939,20 @@ scm_integer_exact_quotient_ii (scm_t_inum n, scm_t_inum 
d)
   return scm_integer_truncate_quotient_ii (n, d);
 }
 
+SCM
+scm_integer_exact_quotient_iz (scm_t_inum n, struct scm_bignum *d)
+{
+  // There are only two fixnum numerators that are evenly divided by
+  // bignum denominators: 0, which is evenly divided 0 times by
+  // anything, and SCM_MOST_NEGATIVE_FIXNUM, which is evenly divided -1
+  // time by SCM_MOST_POSITIVE_FIXNUM+1.
+  if (n == 0)
+    return SCM_INUM0;
+  ASSERT (n == SCM_MOST_NEGATIVE_FIXNUM);
+  ASSERT (bignum_cmp_long (d, SCM_MOST_POSITIVE_FIXNUM + 1) == 0);
+  return SCM_I_MAKINUM (-1);
+}
+
 /* Return the exact integer q such that n = q*d, for exact integers n
    and d, where d is known in advance to divide n evenly (with zero
    remainder).  For large integers, this can be computed more
diff --git a/libguile/integers.h b/libguile/integers.h
index 1acfc1609..470d3ea54 100644
--- a/libguile/integers.h
+++ b/libguile/integers.h
@@ -197,6 +197,8 @@ SCM_INTERNAL int scm_is_integer_divisible_zz (struct 
scm_bignum *x,
                                               struct scm_bignum *y);
 
 SCM_INTERNAL SCM scm_integer_exact_quotient_ii (scm_t_inum n, scm_t_inum d);
+SCM_INTERNAL SCM scm_integer_exact_quotient_iz (scm_t_inum n,
+                                                struct scm_bignum *d);
 SCM_INTERNAL SCM scm_integer_exact_quotient_zi (struct scm_bignum *n,
                                                 scm_t_inum d);
 SCM_INTERNAL SCM scm_integer_exact_quotient_zz (struct scm_bignum *n,
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 9bf85686c..280a91ab4 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -412,22 +412,19 @@ static SCM
 scm_i_make_ratio (SCM numerator, SCM denominator)
 #define FUNC_NAME "make-ratio"
 {
-  /* Make sure the arguments are proper */
-  if (!SCM_LIKELY (SCM_I_INUMP (numerator) || SCM_BIGP (numerator)))
-    SCM_WRONG_TYPE_ARG (1, numerator);
-  else if (!SCM_LIKELY (SCM_I_INUMP (denominator) || SCM_BIGP (denominator)))
-    SCM_WRONG_TYPE_ARG (2, denominator);
-  else
+  if (!scm_is_exact_integer (numerator))
+    abort();
+  if (!scm_is_exact_integer (denominator))
+    abort();
+
+  SCM the_gcd = scm_gcd (numerator, denominator);
+  if (!(scm_is_eq (the_gcd, SCM_INUM1)))
     {
-      SCM the_gcd = scm_gcd (numerator, denominator);
-      if (!(scm_is_eq (the_gcd, SCM_INUM1)))
-       {
-         /* Reduce to lowest terms */
-         numerator = scm_exact_integer_quotient (numerator, the_gcd);
-         denominator = scm_exact_integer_quotient (denominator, the_gcd);
-       }
-      return scm_i_make_ratio_already_reduced (numerator, denominator);
+      /* Reduce to lowest terms */
+      numerator = scm_exact_integer_quotient (numerator, the_gcd);
+      denominator = scm_exact_integer_quotient (denominator, the_gcd);
     }
+  return scm_i_make_ratio_already_reduced (numerator, denominator);
 }
 #undef FUNC_NAME
 
@@ -921,73 +918,30 @@ static SCM
 scm_exact_integer_quotient (SCM n, SCM d)
 #define FUNC_NAME "exact-integer-quotient"
 {
-  if (SCM_LIKELY (SCM_I_INUMP (n)))
+  if (SCM_I_INUMP (n))
     {
-      scm_t_inum nn = SCM_I_INUM (n);
-      if (SCM_LIKELY (SCM_I_INUMP (d)))
-       {
-         scm_t_inum dd = SCM_I_INUM (d);
-         if (SCM_UNLIKELY (dd == 0))
-           scm_num_overflow ("exact-integer-quotient");
-         else
-           {
-             scm_t_inum qq = nn / dd;
-             if (SCM_LIKELY (SCM_FIXABLE (qq)))
-               return SCM_I_MAKINUM (qq);
-             else
-               return scm_i_inum2big (qq);
-           }
-       }
-      else if (SCM_LIKELY (SCM_BIGP (d)))
-       {
-         /* n is an inum and d is a bignum.  Given that d is known to
-            divide n evenly, there are only two possibilities: n is 0,
-            or else n is fixnum-min and d is abs(fixnum-min). */
-         if (nn == 0)
-           return SCM_INUM0;
-         else
-           return SCM_I_MAKINUM (-1);
-       }
+      if (scm_is_eq (n, d))
+        return SCM_INUM1;
+      if (SCM_I_INUMP (d))
+        return scm_integer_exact_quotient_ii (SCM_I_INUM (n), SCM_I_INUM (d));
+      else if (SCM_BIGP (d))
+        return scm_integer_exact_quotient_iz (SCM_I_INUM (n), scm_bignum (d));
       else
-       SCM_WRONG_TYPE_ARG (2, d);
+        abort (); // Unreachable.
     }
-  else if (SCM_LIKELY (SCM_BIGP (n)))
+  else if (SCM_BIGP (n))
     {
-      if (SCM_LIKELY (SCM_I_INUMP (d)))
-       {
-         scm_t_inum dd = SCM_I_INUM (d);
-         if (SCM_UNLIKELY (dd == 0))
-           scm_num_overflow ("exact-integer-quotient");
-         else if (SCM_UNLIKELY (dd == 1))
-           return n;
-         else
-           {
-             SCM q = scm_i_mkbig ();
-             if (dd > 0)
-               mpz_divexact_ui (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (n), dd);
-             else
-               {
-                 mpz_divexact_ui (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (n), -dd);
-                 mpz_neg (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (q));
-               }
-             scm_remember_upto_here_1 (n);
-             return scm_i_normbig (q);
-           }
-       }
-      else if (SCM_LIKELY (SCM_BIGP (d)))
-       {
-         SCM q = scm_i_mkbig ();
-         mpz_divexact (SCM_I_BIG_MPZ (q),
-                       SCM_I_BIG_MPZ (n),
-                       SCM_I_BIG_MPZ (d));
-         scm_remember_upto_here_2 (n, d);
-         return scm_i_normbig (q);
-       }
+      if (scm_is_eq (n, d))
+        return SCM_INUM1;
+      if (SCM_I_INUMP (d))
+        return scm_integer_exact_quotient_zi (scm_bignum (n), SCM_I_INUM (d));
+      else if (SCM_BIGP (d))
+        return scm_integer_exact_quotient_zz (scm_bignum (n), scm_bignum (d));
       else
-       SCM_WRONG_TYPE_ARG (2, d);
+        abort (); // Unreachable.
     }
   else
-    SCM_WRONG_TYPE_ARG (1, n);
+    abort (); // Unreachable.
 }
 #undef FUNC_NAME
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]