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

Implement floor-remainder with new integer lib

Browse source 
* libguile/integers.c (scm_integer_floor_remainder_ii)
(scm_integer_floor_remainder_iz, scm_integer_floor_remainder_zi)
(scm_integer_floor_remainder_zz): New internal functions.
* libguile/integers.h: Declare internal functions.
* libguile/numbers.c (scm_floor_remainder): Use the new functions.
This commit is contained in:
Andy Wingo 2021-12-05 22:08:39 +01:00
parent 31da9be6c4
commit 2e8036ff0f
3 changed files with 86 additions and 71 deletions
Download patch file Download diff file Expand all files Collapse all files

73
libguile/integers.c
View file

@ -338,3 +338,76 @@ scm_integer_floor_quotient_zz (SCM x, SCM y)
scm_remember_upto_here_2 (x, y); scm_remember_upto_here_2 (x, y);
return SCM_PACK (normalize_bignum (take_bignum_from_mpz (q))); return SCM_PACK (normalize_bignum (take_bignum_from_mpz (q)));
} }
SCM
scm_integer_floor_remainder_ii (scm_t_inum x, scm_t_inum y)
{
if (y == 0)
scm_num_overflow ("floor-remainder");
scm_t_inum r = x % y;
int needs_adjustment = (y > 0) ? (r < 0) : (r > 0);
if (needs_adjustment)
r += y;
return SCM_I_MAKINUM (r);
}
SCM
scm_integer_floor_remainder_iz (scm_t_inum x, SCM y)
{
if (!bignum_is_negative (scm_bignum (y)))
{
if (x < 0)
{
mpz_t r, zy;
mpz_init (r);
alias_bignum_to_mpz (scm_bignum (y), zy);
mpz_sub_ui (r, zy, -x);
scm_remember_upto_here_1 (y);
return SCM_PACK (normalize_bignum (take_bignum_from_mpz (r)));
}
else
return SCM_I_MAKINUM (x);
}
else if (x <= 0)
return SCM_I_MAKINUM (x);
else
{
mpz_t r, zy;
mpz_init (r);
alias_bignum_to_mpz (scm_bignum (y), zy);
mpz_add_ui (r, zy, x);
scm_remember_upto_here_1 (y);
return SCM_PACK (normalize_bignum (take_bignum_from_mpz (r)));
}
}
SCM
scm_integer_floor_remainder_zi (SCM x, scm_t_inum y)
{
if (SCM_UNLIKELY (y == 0))
scm_num_overflow ("floor-remainder");
else
{
scm_t_inum r;
mpz_t zx;
alias_bignum_to_mpz (scm_bignum (x), zx);
if (y > 0)
r = mpz_fdiv_ui (zx, y);
else
r = -mpz_cdiv_ui (zx, -y);
scm_remember_upto_here_1 (x);
return SCM_I_MAKINUM (r);
}
}
SCM
scm_integer_floor_remainder_zz (SCM x, SCM y)
{
mpz_t zx, zy, r;
alias_bignum_to_mpz (scm_bignum (x), zx);
alias_bignum_to_mpz (scm_bignum (y), zy);
mpz_init (r);
mpz_fdiv_r (r, zx, zy);
scm_remember_upto_here_2 (x, y);
return SCM_PACK (normalize_bignum (take_bignum_from_mpz (r)));
}

5
libguile/integers.h
View file

@ -34,6 +34,11 @@ SCM_INTERNAL SCM scm_integer_floor_quotient_iz (scm_t_inum x, SCM y);
SCM_INTERNAL SCM scm_integer_floor_quotient_zi (SCM x, scm_t_inum y); SCM_INTERNAL SCM scm_integer_floor_quotient_zi (SCM x, scm_t_inum y);
SCM_INTERNAL SCM scm_integer_floor_quotient_zz (SCM x, SCM y); SCM_INTERNAL SCM scm_integer_floor_quotient_zz (SCM x, SCM y);
SCM_INTERNAL SCM scm_integer_floor_remainder_ii (scm_t_inum x, scm_t_inum y);
SCM_INTERNAL SCM scm_integer_floor_remainder_iz (scm_t_inum x, SCM y);
SCM_INTERNAL SCM scm_integer_floor_remainder_zi (SCM x, scm_t_inum y);
SCM_INTERNAL SCM scm_integer_floor_remainder_zz (SCM x, SCM y);
#endif /* SCM_INTEGERS_H */ #endif /* SCM_INTEGERS_H */

79
libguile/numbers.c
View file

@ -1293,55 +1293,13 @@ SCM_PRIMITIVE_GENERIC (scm_floor_remainder, "floor-remainder", 2, 0, 0,
{ {
if (SCM_LIKELY (SCM_I_INUMP (x))) if (SCM_LIKELY (SCM_I_INUMP (x)))
{ {
scm_t_inum xx = SCM_I_INUM (x); if (SCM_I_INUMP (y))
if (SCM_LIKELY (SCM_I_INUMP (y))) return scm_integer_floor_remainder_ii (SCM_I_INUM (x), SCM_I_INUM (y));
{
scm_t_inum yy = SCM_I_INUM (y);
if (SCM_UNLIKELY (yy == 0))
scm_num_overflow (s_scm_floor_remainder);
else
{
scm_t_inum rr = xx % yy;
int needs_adjustment;
if (SCM_LIKELY (yy > 0))
needs_adjustment = (rr < 0);
else
needs_adjustment = (rr > 0);
if (needs_adjustment)
rr += yy;
return SCM_I_MAKINUM (rr);
}
}
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
{ return scm_integer_floor_remainder_iz (SCM_I_INUM (x), y);
int sign = mpz_sgn (SCM_I_BIG_MPZ (y));
scm_remember_upto_here_1 (y);
if (sign > 0)
{
if (xx < 0)
{
SCM r = scm_i_mkbig ();
mpz_sub_ui (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (y), -xx);
scm_remember_upto_here_1 (y);
return scm_i_normbig (r);
}
else
return x;
}
else if (xx <= 0)
return x;
else
{
SCM r = scm_i_mkbig ();
mpz_add_ui (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (y), xx);
scm_remember_upto_here_1 (y);
return scm_i_normbig (r);
}
}
else if (SCM_REALP (y)) else if (SCM_REALP (y))
return scm_i_inexact_floor_remainder (xx, SCM_REAL_VALUE (y)); return scm_i_inexact_floor_remainder (SCM_I_INUM (x),
SCM_REAL_VALUE (y));
else if (SCM_FRACTIONP (y)) else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_floor_remainder (x, y); return scm_i_exact_rational_floor_remainder (x, y);
else else
@ -1350,31 +1308,10 @@ SCM_PRIMITIVE_GENERIC (scm_floor_remainder, "floor-remainder", 2, 0, 0,
} }
else if (SCM_BIGP (x)) else if (SCM_BIGP (x))
{ {
if (SCM_LIKELY (SCM_I_INUMP (y))) if (SCM_I_INUMP (y))
{ return scm_integer_floor_remainder_zi (x, SCM_I_INUM (y));
scm_t_inum yy = SCM_I_INUM (y);
if (SCM_UNLIKELY (yy == 0))
scm_num_overflow (s_scm_floor_remainder);
else
{
scm_t_inum rr;
if (yy > 0)
rr = mpz_fdiv_ui (SCM_I_BIG_MPZ (x), yy);
else
rr = -mpz_cdiv_ui (SCM_I_BIG_MPZ (x), -yy);
scm_remember_upto_here_1 (x);
return SCM_I_MAKINUM (rr);
}
}
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
{ return scm_integer_floor_remainder_zz (x, y);
SCM r = scm_i_mkbig ();
mpz_fdiv_r (SCM_I_BIG_MPZ (r),
SCM_I_BIG_MPZ (x),
SCM_I_BIG_MPZ (y));
scm_remember_upto_here_2 (x, y);
return scm_i_normbig (r);
}
else if (SCM_REALP (y)) else if (SCM_REALP (y))
return scm_i_inexact_floor_remainder return scm_i_inexact_floor_remainder
(scm_i_big2dbl (x), SCM_REAL_VALUE (y)); (scm_i_big2dbl (x), SCM_REAL_VALUE (y));