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

Implement truncate-remainder with new integer lib

Browse source 
* libguile/integers.c (scm_integer_truncate_remainder_ii)
(scm_integer_truncate_remainder_iz, scm_integer_truncate_remainder_zi)
(scm_integer_truncate_remainder_zz): New internal functions.
* libguile/integers.h: Declare internal functions.
* libguile/numbers.c (scm_truncate_remainder): Use the new functions.
This commit is contained in:
Andy Wingo 2021-12-13 09:50:14 +01:00
parent ff636774b4
commit cbd62a0ef3
3 changed files with 68 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

53
libguile/integers.c
View file

@ -874,3 +874,56 @@ scm_integer_truncate_quotient_zz (SCM x, SCM y)
scm_remember_upto_here_2 (x, y); scm_remember_upto_here_2 (x, y);
return take_mpz (q); return take_mpz (q);
} }
SCM
scm_integer_truncate_remainder_ii (scm_t_inum x, scm_t_inum y)
{
if (y == 0)
scm_num_overflow ("truncate-remainder");
else
{
scm_t_inum q = x % y;
return long_to_scm (q);
}
}
SCM
scm_integer_truncate_remainder_iz (scm_t_inum x, SCM y)
{
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);
}
SCM
scm_integer_truncate_remainder_zi (SCM x, scm_t_inum y)
{
if (y == 0)
scm_num_overflow ("truncate-remainder");
else
{
mpz_t zx;
alias_bignum_to_mpz (scm_bignum (x), zx);
scm_t_inum r = mpz_tdiv_ui (zx, (y > 0) ? y : -y) * mpz_sgn (zx);
scm_remember_upto_here_1 (x);
return SCM_I_MAKINUM (r);
}
}
SCM
scm_integer_truncate_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_tdiv_r (r, zx, zy);
scm_remember_upto_here_2 (x, y);
return take_mpz (r);
}

5
libguile/integers.h
View file

@ -72,6 +72,11 @@ SCM_INTERNAL SCM scm_integer_truncate_quotient_iz (scm_t_inum x, SCM y);
SCM_INTERNAL SCM scm_integer_truncate_quotient_zi (SCM x, scm_t_inum y); SCM_INTERNAL SCM scm_integer_truncate_quotient_zi (SCM x, scm_t_inum y);
SCM_INTERNAL SCM scm_integer_truncate_quotient_zz (SCM x, SCM y); SCM_INTERNAL SCM scm_integer_truncate_quotient_zz (SCM x, SCM y);
SCM_INTERNAL SCM scm_integer_truncate_remainder_ii (scm_t_inum x, scm_t_inum y);
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);
#endif /* SCM_INTEGERS_H */ #endif /* SCM_INTEGERS_H */

55
libguile/numbers.c
View file

@ -1908,32 +1908,16 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder, "truncate-remainder", 2, 0, 0,
"@end lisp") "@end lisp")
#define FUNC_NAME s_scm_truncate_remainder #define FUNC_NAME s_scm_truncate_remainder
{ {
if (SCM_LIKELY (SCM_I_INUMP (x))) if (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_truncate_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_truncate_remainder);
else
return SCM_I_MAKINUM (xx % yy);
}
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
{ return scm_integer_truncate_remainder_iz (SCM_I_INUM (x), 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);
return SCM_INUM0;
}
else
return x;
}
else if (SCM_REALP (y)) else if (SCM_REALP (y))
return scm_i_inexact_truncate_remainder (xx, SCM_REAL_VALUE (y)); return scm_i_inexact_truncate_remainder (SCM_I_INUM (x),
SCM_REAL_VALUE (y));
else if (SCM_FRACTIONP (y)) else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_truncate_remainder (x, y); return scm_i_exact_rational_truncate_remainder (x, y);
else else
@ -1942,29 +1926,10 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder, "truncate-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_truncate_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_truncate_remainder);
else
{
scm_t_inum rr = (mpz_tdiv_ui (SCM_I_BIG_MPZ (x),
(yy > 0) ? yy : -yy)
* mpz_sgn (SCM_I_BIG_MPZ (x)));
scm_remember_upto_here_1 (x);
return SCM_I_MAKINUM (rr);
}
}
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
{ return scm_integer_truncate_remainder_zz (x, y);
SCM r = scm_i_mkbig ();
mpz_tdiv_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_truncate_remainder return scm_i_inexact_truncate_remainder
(scm_i_big2dbl (x), SCM_REAL_VALUE (y)); (scm_i_big2dbl (x), SCM_REAL_VALUE (y));