mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 22:31:12 +02:00
Code Activity

Implement truncate-divide with new integer lib

Browse source 
* libguile/integers.c (scm_integer_truncate_divide_ii)
(scm_integer_truncate_divide_iz, scm_integer_truncate_divide_zi)
(scm_integer_truncate_divide_zz): New internal functions.
* libguile/integers.h: Declare internal functions.
* libguile/numbers.c (scm_truncate_divide): Use the new functions.
This commit is contained in:
Andy Wingo 2021-12-13 09:58:55 +01:00
parent cbd62a0ef3
commit f8a92773ac
3 changed files with 90 additions and 68 deletions
Download patch file Download diff file Expand all files Collapse all files

71
libguile/integers.c
View file

@ -927,3 +927,74 @@ scm_integer_truncate_remainder_zz (SCM x, SCM y)
scm_remember_upto_here_2 (x, y);
return take_mpz (r);
}
void
scm_integer_truncate_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp)
{
if (y == 0)
scm_num_overflow ("truncate-divide");
else
{
scm_t_inum q = x / y;
scm_t_inum r = x % y;
*qp = long_to_scm (q);
*rp = SCM_I_MAKINUM (r);
}
}
void
scm_integer_truncate_divide_iz (scm_t_inum x, SCM y, SCM *qp, SCM *rp)
{
if (x == SCM_MOST_NEGATIVE_FIXNUM &&
bignum_cmp_long (scm_bignum (y), -SCM_MOST_NEGATIVE_FIXNUM) == 0)
{
/* Special case: x == fixnum-min && y == abs (fixnum-min) */
scm_remember_upto_here_1 (y);
*qp = SCM_I_MAKINUM (-1);
*rp = SCM_INUM0;
}
else
{
*qp = SCM_INUM0;
*rp = SCM_I_MAKINUM (x);
}
}
void
scm_integer_truncate_divide_zi (SCM x, scm_t_inum y, SCM *qp, SCM *rp)
{
if (y == 0)
scm_num_overflow ("truncate-divide");
else
{
mpz_t q, zx;
mpz_init (q);
alias_bignum_to_mpz (scm_bignum (x), zx);
scm_t_inum r;
if (y > 0)
r = mpz_tdiv_q_ui (q, zx, y);
else
{
r = mpz_tdiv_q_ui (q, zx, -y);
mpz_neg (q, q);
}
r *= mpz_sgn (zx);
scm_remember_upto_here_1 (x);
*qp = take_mpz (q);
*rp = SCM_I_MAKINUM (r);
}
}
void
scm_integer_truncate_divide_zz (SCM x, SCM y, SCM *qp, SCM *rp)
{
mpz_t q, r, zx, zy;
mpz_init (q);
mpz_init (r);
alias_bignum_to_mpz (scm_bignum (x), zx);
alias_bignum_to_mpz (scm_bignum (y), zy);
mpz_tdiv_qr (q, r, zx, zy);
scm_remember_upto_here_2 (x, y);
*qp = take_mpz (q);
*rp = take_mpz (r);
}

9
libguile/integers.h
View file

@ -77,6 +77,15 @@ SCM_INTERNAL SCM scm_integer_truncate_remainder_iz (scm_t_inum x, SCM y);
SCM_INTERNAL SCM scm_integer_truncate_remainder_zi (SCM x, scm_t_inum y);
SCM_INTERNAL SCM scm_integer_truncate_remainder_zz (SCM x, SCM y);
SCM_INTERNAL void scm_integer_truncate_divide_ii (scm_t_inum x, scm_t_inum y,
SCM *qp, SCM *rp);
SCM_INTERNAL void scm_integer_truncate_divide_iz (scm_t_inum x, SCM y,
SCM *qp, SCM *rp);
SCM_INTERNAL void scm_integer_truncate_divide_zi (SCM x, scm_t_inum y,
SCM *qp, SCM *rp);
SCM_INTERNAL void scm_integer_truncate_divide_zz (SCM x, SCM y,
SCM *qp, SCM *rp);
#endif /* SCM_INTEGERS_H */

78
libguile/numbers.c
View file

@ -2026,44 +2026,16 @@ SCM_PRIMITIVE_GENERIC (scm_i_truncate_divide, "truncate/", 2, 0, 0,
void
scm_truncate_divide (SCM x, SCM y, SCM *qp, SCM *rp)
{
if (SCM_LIKELY (SCM_I_INUMP (x)))
if (SCM_I_INUMP (x))
{
scm_t_inum xx = SCM_I_INUM (x);
if (SCM_LIKELY (SCM_I_INUMP (y)))
{
scm_t_inum yy = SCM_I_INUM (y);
if (SCM_UNLIKELY (yy == 0))
scm_num_overflow (s_scm_truncate_divide);
else
{
scm_t_inum qq = xx / yy;
scm_t_inum rr = xx % yy;
if (SCM_LIKELY (SCM_FIXABLE (qq)))
*qp = SCM_I_MAKINUM (qq);
else
*qp = scm_i_inum2big (qq);
*rp = SCM_I_MAKINUM (rr);
}
}
if (SCM_I_INUMP (y))
scm_integer_truncate_divide_ii (SCM_I_INUM (x), SCM_I_INUM (y),
qp, rp);
else if (SCM_BIGP (y))
{
if (SCM_UNLIKELY (xx == SCM_MOST_NEGATIVE_FIXNUM)
&& SCM_UNLIKELY (mpz_cmp_ui (SCM_I_BIG_MPZ (y),
- SCM_MOST_NEGATIVE_FIXNUM) == 0))
{
/* Special case: x == fixnum-min && y == abs (fixnum-min) */
scm_remember_upto_here_1 (y);
*qp = SCM_I_MAKINUM (-1);
*rp = SCM_INUM0;
}
else
{
*qp = SCM_INUM0;
*rp = x;
}
}
scm_integer_truncate_divide_iz (SCM_I_INUM (x), y, qp, rp);
else if (SCM_REALP (y))
scm_i_inexact_truncate_divide (xx, SCM_REAL_VALUE (y), qp, rp);
scm_i_inexact_truncate_divide (SCM_I_INUM (x), SCM_REAL_VALUE (y),
qp, rp);
else if (SCM_FRACTIONP (y))
scm_i_exact_rational_truncate_divide (x, y, qp, rp);
else
@ -2072,40 +2044,10 @@ scm_truncate_divide (SCM x, SCM y, SCM *qp, SCM *rp)
}
else if (SCM_BIGP (x))
{
if (SCM_LIKELY (SCM_I_INUMP (y)))
{
scm_t_inum yy = SCM_I_INUM (y);
if (SCM_UNLIKELY (yy == 0))
scm_num_overflow (s_scm_truncate_divide);
else
{
SCM q = scm_i_mkbig ();
scm_t_inum rr;
if (yy > 0)
rr = mpz_tdiv_q_ui (SCM_I_BIG_MPZ (q),
SCM_I_BIG_MPZ (x), yy);
else
{
rr = mpz_tdiv_q_ui (SCM_I_BIG_MPZ (q),
SCM_I_BIG_MPZ (x), -yy);
mpz_neg (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (q));
}
rr *= mpz_sgn (SCM_I_BIG_MPZ (x));
scm_remember_upto_here_1 (x);
*qp = scm_i_normbig (q);
*rp = SCM_I_MAKINUM (rr);
}
}
if (SCM_I_INUMP (y))
scm_integer_truncate_divide_zi (x, SCM_I_INUM (y), qp, rp);
else if (SCM_BIGP (y))
{
SCM q = scm_i_mkbig ();
SCM r = scm_i_mkbig ();
mpz_tdiv_qr (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (r),
SCM_I_BIG_MPZ (x), SCM_I_BIG_MPZ (y));
scm_remember_upto_here_2 (x, y);
*qp = scm_i_normbig (q);
*rp = scm_i_normbig (r);
}
scm_integer_truncate_divide_zz (x, y, qp, rp);
else if (SCM_REALP (y))
scm_i_inexact_truncate_divide (scm_i_big2dbl (x), SCM_REAL_VALUE (y),
qp, rp);