[Guile-commits] 20/85: Implement lcm with new integer lib

[Andy Wingo]

wingo pushed a commit to branch main
in repository guile.

commit 6fa9fcb313e75164316dbc048aba4cd65e531676
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Sun Dec 19 09:52:39 2021 +0100

    Implement lcm with new integer lib
    
    * libguile/integers.c (scm_integer_lcm_ii)
    (scm_integer_lcm_zi, scm_integer_lcm_zz): New internal functions.
    * libguile/integers.h: Declare internal functions.
    * libguile/numbers.c (scm_lcm): Use the new functions.
---
 libguile/integers.c | 37 +++++++++++++++++++++++++++++++++++++
 libguile/integers.h |  4 ++++
 libguile/numbers.c  | 48 +++++++++---------------------------------------
 3 files changed, 50 insertions(+), 39 deletions(-)

diff --git a/libguile/integers.c b/libguile/integers.c
index cca40bc8b..3c7a86709 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -1817,3 +1817,40 @@ scm_integer_gcd_zz (SCM x, SCM y)
   scm_remember_upto_here_2 (x, y);
   return take_mpz (result);
 }
+
+SCM
+scm_integer_lcm_ii (scm_t_inum x, scm_t_inum y)
+{
+  SCM d = scm_integer_gcd_ii (x, y);
+  if (scm_is_eq (d, SCM_INUM0))
+    return d;
+  else
+    return scm_abs (scm_product (SCM_I_MAKINUM (x),
+                                 scm_quotient (SCM_I_MAKINUM (y), d)));
+}
+
+SCM
+scm_integer_lcm_zi (SCM x, scm_t_inum y)
+{
+  if (y == 0) return SCM_INUM0;
+  if (y < 0) y = - y;
+  mpz_t result, zx;
+  mpz_init (result);
+  alias_bignum_to_mpz (scm_bignum (x), zx);
+  mpz_lcm_ui (result, zx, y);
+  scm_remember_upto_here_1 (x);
+  return take_mpz (result);
+}
+
+SCM
+scm_integer_lcm_zz (SCM x, SCM y)
+{
+  mpz_t result, zx, zy;
+  mpz_init (result);
+  alias_bignum_to_mpz (scm_bignum (x), zx);
+  alias_bignum_to_mpz (scm_bignum (y), zy);
+  mpz_lcm (result, zx, zy);
+  scm_remember_upto_here_2 (x, y);
+  /* shouldn't need to normalize b/c lcm of 2 bigs should be big */
+  return take_mpz (result);
+}
diff --git a/libguile/integers.h b/libguile/integers.h
index 699525b3f..31407b79e 100644
--- a/libguile/integers.h
+++ b/libguile/integers.h
@@ -128,6 +128,10 @@ SCM_INTERNAL SCM scm_integer_gcd_ii (scm_t_inum x, 
scm_t_inum y);
 SCM_INTERNAL SCM scm_integer_gcd_zi (SCM x, scm_t_inum y);
 SCM_INTERNAL SCM scm_integer_gcd_zz (SCM x, SCM y);
 
+SCM_INTERNAL SCM scm_integer_lcm_ii (scm_t_inum x, scm_t_inum y);
+SCM_INTERNAL SCM scm_integer_lcm_zi (SCM x, scm_t_inum y);
+SCM_INTERNAL SCM scm_integer_lcm_zz (SCM x, SCM y);
+
 
 
 #endif  /* SCM_INTEGERS_H */
diff --git a/libguile/numbers.c b/libguile/numbers.c
index f0ddc9379..7aea6661a 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -2844,33 +2844,15 @@ SCM_PRIMITIVE_GENERIC (scm_i_lcm, "lcm", 0, 2, 1,
 SCM
 scm_lcm (SCM n1, SCM n2)
 {
-  if (SCM_UNLIKELY (SCM_UNBNDP (n2)))
+  if (SCM_UNBNDP (n2))
     return SCM_UNBNDP (n1) ? SCM_INUM1 : scm_abs (n1);
 
-  if (SCM_LIKELY (SCM_I_INUMP (n1)))
+  if (SCM_I_INUMP (n1))
     {
-      if (SCM_LIKELY (SCM_I_INUMP (n2)))
-        {
-          SCM d = scm_gcd (n1, n2);
-          if (scm_is_eq (d, SCM_INUM0))
-            return d;
-          else
-            return scm_abs (scm_product (n1, scm_quotient (n2, d)));
-        }
-      else if (SCM_LIKELY (SCM_BIGP (n2)))
-        {
-          /* inum n1, big n2 */
-        inumbig:
-          {
-            SCM result = scm_i_mkbig ();
-            scm_t_inum nn1 = SCM_I_INUM (n1);
-            if (nn1 == 0) return SCM_INUM0;
-            if (nn1 < 0) nn1 = - nn1;
-            mpz_lcm_ui (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (n2), nn1);
-            scm_remember_upto_here_1 (n2);
-            return result;
-          }
-        }
+      if (SCM_I_INUMP (n2))
+        return scm_integer_lcm_ii (SCM_I_INUM (n1), SCM_I_INUM (n2));
+      else if (SCM_BIGP (n2))
+        return scm_integer_lcm_zi (n2, SCM_I_INUM (n1));
       else if (SCM_REALP (n2) && scm_is_integer (n2))
         goto handle_inexacts;
       else
@@ -2878,22 +2860,10 @@ scm_lcm (SCM n1, SCM n2)
     }
   else if (SCM_LIKELY (SCM_BIGP (n1)))
     {
-      /* big n1 */
       if (SCM_I_INUMP (n2))
-        {
-          SCM_SWAP (n1, n2);
-          goto inumbig;
-        }
-      else if (SCM_LIKELY (SCM_BIGP (n2)))
-        {
-          SCM result = scm_i_mkbig ();
-          mpz_lcm(SCM_I_BIG_MPZ (result),
-                  SCM_I_BIG_MPZ (n1),
-                  SCM_I_BIG_MPZ (n2));
-          scm_remember_upto_here_2(n1, n2);
-          /* shouldn't need to normalize b/c lcm of 2 bigs should be big */
-          return result;
-        }
+        return scm_integer_lcm_zi (n1, SCM_I_INUM (n2));
+      else if (SCM_BIGP (n2))
+        return scm_integer_lcm_zz (n1, n2);
       else if (SCM_REALP (n2) && scm_is_integer (n2))
         goto handle_inexacts;
       else