mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 14:30:34 +02:00
Code Activity

Reimplement exact-integer-sqrt with integers.[ch]

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2022-01-06 22:07:20 +01:00
parent 9a91c20a55
commit 63a18a6c1a
3 changed files with 44 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

30
libguile/integers.c
View file

@ -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);
}

4
libguile/integers.h
View file

@ -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 */

41
libguile/numbers.c
View file

@ -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.