[Guile-commits] 55/85: Reimplement exact-integer-sqrt with integers.[ch]

[Andy Wingo]

wingo pushed a commit to branch main
in repository guile.

commit 63a18a6c1a2eae570c5de2b9eb866b20bc5e5e5e
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Thu Jan 6 22:07:20 2022 +0100

    Reimplement exact-integer-sqrt with integers.[ch]
    
    * libguile/numbers.c (scm_exact_integer_sqrt): Call out.
    * libguile/integers.h:
    * libguile/integers.c (scm_integer_exact_sqrt_i):
    (scm_integer_exact_sqrt_z): New internal functions.
---
 libguile/integers.c | 30 ++++++++++++++++++++++++++++++
 libguile/integers.h |  4 ++++
 libguile/numbers.c  | 41 ++++++++++-------------------------------
 3 files changed, 44 insertions(+), 31 deletions(-)

diff --git a/libguile/integers.c b/libguile/integers.c
index 0ca799b9e..d318fd775 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -3044,3 +3044,33 @@ scm_integer_to_mpz_z (struct scm_bignum *z, mpz_t n)
   mpz_init_set (n, zn);
   scm_remember_upto_here_1 (z);
 }
+
+void
+scm_integer_exact_sqrt_i (scm_t_inum k, SCM *s, SCM *r)
+{
+  ASSERT (k >= 0);
+  if (k == 0)
+    *s = *r = SCM_INUM0;
+  else
+    {
+      mp_limb_t kk = k, ss, rr;
+      if (mpn_sqrtrem (&ss, &rr, &kk, 1) == 0)
+        rr = 0;
+      *s = SCM_I_MAKINUM (ss);
+      *r = SCM_I_MAKINUM (rr);
+    }
+}
+
+void
+scm_integer_exact_sqrt_z (struct scm_bignum *k, SCM *s, SCM *r)
+{
+  mpz_t zk, zs, zr;
+  alias_bignum_to_mpz (k, zk);
+  mpz_init (zs);
+  mpz_init (zr);
+
+  mpz_sqrtrem (zs, zr, zk);
+  scm_remember_upto_here_1 (k);
+  *s = take_mpz (zs);
+  *r = take_mpz (zr);
+}
diff --git a/libguile/integers.h b/libguile/integers.h
index e48db1d17..1bba509ea 100644
--- a/libguile/integers.h
+++ b/libguile/integers.h
@@ -212,6 +212,10 @@ SCM_INTERNAL int scm_integer_to_uint64_z (struct 
scm_bignum *z, uint64_t *val);
 SCM_INTERNAL SCM scm_integer_from_int64 (int64_t n);
 SCM_INTERNAL SCM scm_integer_from_uint64 (uint64_t n);
 
+SCM_INTERNAL void scm_integer_exact_sqrt_i (scm_t_inum k, SCM *s, SCM *r);
+SCM_INTERNAL void scm_integer_exact_sqrt_z (struct scm_bignum *k,
+                                            SCM *s, SCM *r);
+
 
 
 #endif  /* SCM_INTEGERS_H */
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 330ea2cdd..7567ced89 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -7374,41 +7374,20 @@ SCM_DEFINE (scm_i_exact_integer_sqrt, 
"exact-integer-sqrt", 1, 0, 0,
 void
 scm_exact_integer_sqrt (SCM k, SCM *sp, SCM *rp)
 {
-  if (SCM_LIKELY (SCM_I_INUMP (k)))
+  if (SCM_I_INUMP (k))
     {
-      if (SCM_I_INUM (k) > 0)
-        {
-          mp_limb_t kk, ss, rr;
-
-          kk = SCM_I_INUM (k);
-          if (mpn_sqrtrem (&ss, &rr, &kk, 1) == 0)
-            rr = 0;
-          *sp = SCM_I_MAKINUM (ss);
-          *rp = SCM_I_MAKINUM (rr);
-        }
-      else if (SCM_I_INUM (k) == 0)
-        *sp = *rp = SCM_INUM0;
-      else
-        scm_wrong_type_arg_msg ("exact-integer-sqrt", SCM_ARG1, k,
-                                "exact non-negative integer");
+      scm_t_inum kk = SCM_I_INUM (k);
+      if (kk >= 0)
+        return scm_integer_exact_sqrt_i (kk, sp, rp);
     }
-  else if (SCM_LIKELY (SCM_BIGP (k)))
+  else if (SCM_BIGP (k))
     {
-      SCM s, r;
-
-      if (mpz_sgn (SCM_I_BIG_MPZ (k)) < 0)
-       scm_wrong_type_arg_msg ("exact-integer-sqrt", SCM_ARG1, k,
-                               "exact non-negative integer");
-      s = scm_i_mkbig ();
-      r = scm_i_mkbig ();
-      mpz_sqrtrem (SCM_I_BIG_MPZ (s), SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (k));
-      scm_remember_upto_here_1 (k);
-      *sp = scm_i_normbig (s);
-      *rp = scm_i_normbig (r);
+      struct scm_bignum *zk = scm_bignum (k);
+      if (!scm_is_integer_negative_z (zk))
+        return scm_integer_exact_sqrt_z (zk, sp, rp);
     }
-  else
-    scm_wrong_type_arg_msg ("exact-integer-sqrt", SCM_ARG1, k,
-                           "exact non-negative integer");
+  scm_wrong_type_arg_msg ("exact-integer-sqrt", SCM_ARG1, k,
+                          "exact non-negative integer");
 }
 
 /* Return true iff K is a perfect square.