wingo pushed a commit to branch wip-inline-digits
in repository guile.
commit 84e5ad44bad2b93ddb821ec70a394dd800d053d5
Author: Andy Wingo <[email protected]>
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.
