mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-11 22:31:12 +02:00
Implement ceiling-remainder with new integer lib
* libguile/integers.c (scm_integer_ceiling_remainder_ii) (scm_integer_ceiling_remainder_iz, scm_integer_ceiling_remainder_zi) (scm_integer_ceiling_remainder_zz): New internal functions. (bignum_is_positive): New helper. * libguile/integers.h: Declare internal functions. * libguile/numbers.c (scm_ceiling_remainder): Use the new functions.
This commit is contained in:
Andy Wingo
parent
c1d8dd5e6a
commit
55f93d7d29
3 changed files with 108 additions and 85 deletions
|
|
@ -85,6 +85,12 @@ bignum_is_negative (struct scm_bignum *z)
|
|||
return bignum_size (z) < 0;
|
||||
}
|
||||
|
||||
static int
|
||||
bignum_is_positive (struct scm_bignum *z)
|
||||
{
|
||||
return bignum_size (z) > 0;
|
||||
}
|
||||
|
||||
static size_t
|
||||
bignum_limb_count (struct scm_bignum *z)
|
||||
{
|
||||
|
|
@ -382,7 +388,7 @@ scm_integer_floor_remainder_ii (scm_t_inum x, scm_t_inum y)
|
|||
SCM
|
||||
scm_integer_floor_remainder_iz (scm_t_inum x, SCM y)
|
||||
{
|
||||
if (!bignum_is_negative (scm_bignum (y)))
|
||||
if (bignum_is_positive (scm_bignum (y)))
|
||||
{
|
||||
if (x < 0)
|
||||
{
|
||||
|
|
@ -463,7 +469,7 @@ scm_integer_floor_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp)
|
|||
void
|
||||
scm_integer_floor_divide_iz (scm_t_inum x, SCM y, SCM *qp, SCM *rp)
|
||||
{
|
||||
if (!bignum_is_negative (scm_bignum (y)))
|
||||
if (bignum_is_positive (scm_bignum (y)))
|
||||
{
|
||||
if (x < 0)
|
||||
{
|
||||
|
|
@ -555,7 +561,7 @@ scm_integer_ceiling_quotient_ii (scm_t_inum x, scm_t_inum y)
|
|||
SCM
|
||||
scm_integer_ceiling_quotient_iz (scm_t_inum x, SCM y)
|
||||
{
|
||||
if (!bignum_is_negative (scm_bignum (y)))
|
||||
if (bignum_is_positive (scm_bignum (y)))
|
||||
{
|
||||
if (x > 0)
|
||||
return SCM_INUM1;
|
||||
|
|
@ -610,3 +616,87 @@ scm_integer_ceiling_quotient_zz (SCM x, SCM y)
|
|||
scm_remember_upto_here_2 (x, y);
|
||||
return take_bignum_from_mpz (q);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_integer_ceiling_remainder_ii (scm_t_inum x, scm_t_inum y)
|
||||
{
|
||||
if (y == 0)
|
||||
scm_num_overflow ("ceiling-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_ceiling_remainder_iz (scm_t_inum x, SCM y)
|
||||
{
|
||||
if (bignum_is_positive (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);
|
||||
mpz_neg (r, r);
|
||||
return take_bignum_from_mpz (r);
|
||||
}
|
||||
else 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);
|
||||
return SCM_INUM0;
|
||||
}
|
||||
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);
|
||||
mpz_neg (r, r);
|
||||
return take_bignum_from_mpz (r);
|
||||
}
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_integer_ceiling_remainder_zi (SCM x, scm_t_inum y)
|
||||
{
|
||||
if (y == 0)
|
||||
scm_num_overflow ("ceiling-remainder");
|
||||
else
|
||||
{
|
||||
mpz_t zx;
|
||||
alias_bignum_to_mpz (scm_bignum (x), zx);
|
||||
scm_t_inum r;
|
||||
if (y > 0)
|
||||
r = -mpz_cdiv_ui (zx, y);
|
||||
else
|
||||
r = mpz_fdiv_ui (zx, -y);
|
||||
scm_remember_upto_here_1 (x);
|
||||
return SCM_I_MAKINUM (r);
|
||||
}
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_integer_ceiling_remainder_zz (SCM x, SCM y)
|
||||
{
|
||||
mpz_t r, zx, zy;
|
||||
mpz_init (r);
|
||||
alias_bignum_to_mpz (scm_bignum (x), zx);
|
||||
alias_bignum_to_mpz (scm_bignum (y), zy);
|
||||
mpz_cdiv_r (r, zx, zy);
|
||||
scm_remember_upto_here_2 (x, y);
|
||||
return take_bignum_from_mpz (r);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -53,6 +53,11 @@ SCM_INTERNAL SCM scm_integer_ceiling_quotient_iz (scm_t_inum x, SCM y);
|
|||
SCM_INTERNAL SCM scm_integer_ceiling_quotient_zi (SCM x, scm_t_inum y);
|
||||
SCM_INTERNAL SCM scm_integer_ceiling_quotient_zz (SCM x, SCM y);
|
||||
|
||||
SCM_INTERNAL SCM scm_integer_ceiling_remainder_ii (scm_t_inum x, scm_t_inum y);
|
||||
SCM_INTERNAL SCM scm_integer_ceiling_remainder_iz (scm_t_inum x, SCM y);
|
||||
SCM_INTERNAL SCM scm_integer_ceiling_remainder_zi (SCM x, scm_t_inum y);
|
||||
SCM_INTERNAL SCM scm_integer_ceiling_remainder_zz (SCM x, SCM y);
|
||||
|
||||
|
||||
|
||||
#endif /* SCM_INTEGERS_H */
|
||||
|
|
|
|||
|
|
@ -1599,67 +1599,16 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_remainder, "ceiling-remainder", 2, 0, 0,
|
|||
"@end lisp")
|
||||
#define FUNC_NAME s_scm_ceiling_remainder
|
||||
{
|
||||
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_ceiling_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);
|
||||
}
|
||||
}
|
||||
if (SCM_I_INUMP (y))
|
||||
return scm_integer_ceiling_remainder_ii (SCM_I_INUM (x),
|
||||
SCM_I_INUM (y));
|
||||
else if (SCM_BIGP (y))
|
||||
{
|
||||
int sign = mpz_sgn (SCM_I_BIG_MPZ (y));
|
||||
scm_remember_upto_here_1 (y);
|
||||
if (SCM_LIKELY (sign > 0))
|
||||
{
|
||||
if (SCM_LIKELY (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);
|
||||
mpz_neg (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r));
|
||||
return scm_i_normbig (r);
|
||||
}
|
||||
else 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);
|
||||
return SCM_INUM0;
|
||||
}
|
||||
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);
|
||||
mpz_neg (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r));
|
||||
return scm_i_normbig (r);
|
||||
}
|
||||
}
|
||||
return scm_integer_ceiling_remainder_iz (SCM_I_INUM (x), y);
|
||||
else if (SCM_REALP (y))
|
||||
return scm_i_inexact_ceiling_remainder (xx, SCM_REAL_VALUE (y));
|
||||
return scm_i_inexact_ceiling_remainder (SCM_I_INUM (x),
|
||||
SCM_REAL_VALUE (y));
|
||||
else if (SCM_FRACTIONP (y))
|
||||
return scm_i_exact_rational_ceiling_remainder (x, y);
|
||||
else
|
||||
|
|
@ -1668,31 +1617,10 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_remainder, "ceiling-remainder", 2, 0, 0,
|
|||
}
|
||||
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_ceiling_remainder);
|
||||
else
|
||||
{
|
||||
scm_t_inum rr;
|
||||
if (yy > 0)
|
||||
rr = -mpz_cdiv_ui (SCM_I_BIG_MPZ (x), yy);
|
||||
else
|
||||
rr = mpz_fdiv_ui (SCM_I_BIG_MPZ (x), -yy);
|
||||
scm_remember_upto_here_1 (x);
|
||||
return SCM_I_MAKINUM (rr);
|
||||
}
|
||||
}
|
||||
if (SCM_I_INUMP (y))
|
||||
return scm_integer_ceiling_remainder_zi (x, SCM_I_INUM (y));
|
||||
else if (SCM_BIGP (y))
|
||||
{
|
||||
SCM r = scm_i_mkbig ();
|
||||
mpz_cdiv_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);
|
||||
}
|
||||
return scm_integer_ceiling_remainder_zz (x, y);
|
||||
else if (SCM_REALP (y))
|
||||
return scm_i_inexact_ceiling_remainder
|
||||
(scm_i_big2dbl (x), SCM_REAL_VALUE (y));
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue