summaryrefslogtreecommitdiff
path: root/libguile/numbers.c
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2011-02-10 15:40:57 -0500
committerAndy Wingo <wingo@pobox.com>2011-02-12 13:00:43 +0100
commit4a46bc2a5f9a0d992c67e0be3eab64077b8421a6 (patch)
tree84a06558251736728793d4be307659077b62f6a6 /libguile/numbers.c
parentbc3d34f58785f843f588d3ed5dc76adf45e9811e (diff)
downloadguile-4a46bc2a5f9a0d992c67e0be3eab64077b8421a6.tar.gz
Fixes and improvements to number-theoretic division operators
* libguile/numbers.c (scm_euclidean_quotient, scm_euclidean_divide, scm_centered_quotient, scm_centered_divide): Fix bug in inum/inum case, where (quotient most-negative-fixnum -1) would not be converted to a bignum. (scm_euclidean_quotient): Be more anal-retentive about calling scm_remember_upto_here_1 after mpz_sgn, (even though mpz_sgn is documented as being implemented as a macro and certainly won't do any allocation). It's better to be safe than sorry here. (scm_euclidean_quotient, scm_centered_quotient): In the bignum/inum case, check if the divisor is 1, since this will allow us to avoid allocating a new bignum. (scm_euclidean_divide, scm_centered_quotient, scm_centered_divide): When computing the intermediate truncated quotient (xx / yy) and remainder, use (xx % yy) instead of (xx - qq * yy), on the theory that the compiler is more likely to handle this case intelligently and maybe combine the operations. (scm_euclidean_divide): In the bignum/inum case, we know that the remainder will fit in an fixnum, so don't bother allocating a bignum for it. (scm_euclidean_quotient, scm_euclidean_remainder, scm_euclidean_divide, scm_centered_quotient, scm_centered_remainder, scm_centered_divide): Minor stylistic changes. * test-suite/tests/numbers.test: Rework testing framework for number-theoretic division operators to be more efficient and comprehensive in its testing of code paths and problem cases.
Diffstat (limited to 'libguile/numbers.c')
-rw-r--r--libguile/numbers.c100
1 files changed, 57 insertions, 43 deletions
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 1aed0c2b6..05840eff6 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -1089,6 +1089,7 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_quotient, "euclidean-quotient", 2, 0, 0,
{
if (SCM_LIKELY (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);
@@ -1096,7 +1097,6 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_quotient, "euclidean-quotient", 2, 0, 0,
scm_num_overflow (s_scm_euclidean_quotient);
else
{
- scm_t_inum xx = SCM_I_INUM (x);
scm_t_inum qq = xx / yy;
if (xx < qq * yy)
{
@@ -1105,19 +1105,25 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_quotient, "euclidean-quotient", 2, 0, 0,
else
qq++;
}
- return SCM_I_MAKINUM (qq);
+ if (SCM_LIKELY (SCM_FIXABLE (qq)))
+ return SCM_I_MAKINUM (qq);
+ else
+ return scm_i_inum2big (qq);
}
}
else if (SCM_BIGP (y))
{
- if (SCM_I_INUM (x) >= 0)
+ if (xx >= 0)
return SCM_INUM0;
else
- return SCM_I_MAKINUM (- mpz_sgn (SCM_I_BIG_MPZ (y)));
+ {
+ scm_t_inum qq = - mpz_sgn (SCM_I_BIG_MPZ (y));
+ scm_remember_upto_here_1 (y);
+ return SCM_I_MAKINUM (qq);
+ }
}
else if (SCM_REALP (y))
- return scm_i_inexact_euclidean_quotient
- (SCM_I_INUM (x), SCM_REAL_VALUE (y));
+ return scm_i_inexact_euclidean_quotient (xx, SCM_REAL_VALUE (y));
else if (SCM_FRACTIONP (y))
return scm_i_slow_exact_euclidean_quotient (x, y);
else
@@ -1131,6 +1137,8 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_quotient, "euclidean-quotient", 2, 0, 0,
scm_t_inum yy = SCM_I_INUM (y);
if (SCM_UNLIKELY (yy == 0))
scm_num_overflow (s_scm_euclidean_quotient);
+ else if (SCM_UNLIKELY (yy == 1))
+ return x;
else
{
SCM q = scm_i_mkbig ();
@@ -1246,6 +1254,7 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_remainder, "euclidean-remainder", 2, 0, 0,
{
if (SCM_LIKELY (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);
@@ -1253,7 +1262,7 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_remainder, "euclidean-remainder", 2, 0, 0,
scm_num_overflow (s_scm_euclidean_remainder);
else
{
- scm_t_inum rr = SCM_I_INUM (x) % yy;
+ scm_t_inum rr = xx % yy;
if (rr >= 0)
return SCM_I_MAKINUM (rr);
else if (yy > 0)
@@ -1264,7 +1273,6 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_remainder, "euclidean-remainder", 2, 0, 0,
}
else if (SCM_BIGP (y))
{
- scm_t_inum xx = SCM_I_INUM (x);
if (xx >= 0)
return x;
else if (mpz_sgn (SCM_I_BIG_MPZ (y)) > 0)
@@ -1284,8 +1292,7 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_remainder, "euclidean-remainder", 2, 0, 0,
}
}
else if (SCM_REALP (y))
- return scm_i_inexact_euclidean_remainder
- (SCM_I_INUM (x), SCM_REAL_VALUE (y));
+ return scm_i_inexact_euclidean_remainder (xx, SCM_REAL_VALUE (y));
else if (SCM_FRACTIONP (y))
return scm_i_slow_exact_euclidean_remainder (x, y);
else
@@ -1420,6 +1427,7 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0,
{
if (SCM_LIKELY (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);
@@ -1427,9 +1435,10 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0,
scm_num_overflow (s_scm_euclidean_divide);
else
{
- scm_t_inum xx = SCM_I_INUM (x);
scm_t_inum qq = xx / yy;
- scm_t_inum rr = xx - qq * yy;
+ scm_t_inum rr = xx % yy;
+ SCM q;
+
if (rr < 0)
{
if (yy > 0)
@@ -1437,13 +1446,15 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0,
else
{ rr -= yy; qq++; }
}
- return scm_values (scm_list_2 (SCM_I_MAKINUM (qq),
- SCM_I_MAKINUM (rr)));
+ if (SCM_LIKELY (SCM_FIXABLE (qq)))
+ q = SCM_I_MAKINUM (qq);
+ else
+ q = scm_i_inum2big (qq);
+ return scm_values (scm_list_2 (q, SCM_I_MAKINUM (rr)));
}
}
else if (SCM_BIGP (y))
{
- scm_t_inum xx = SCM_I_INUM (x);
if (xx >= 0)
return scm_values (scm_list_2 (SCM_INUM0, x));
else if (mpz_sgn (SCM_I_BIG_MPZ (y)) > 0)
@@ -1464,8 +1475,7 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0,
}
}
else if (SCM_REALP (y))
- return scm_i_inexact_euclidean_divide
- (SCM_I_INUM (x), SCM_REAL_VALUE (y));
+ return scm_i_inexact_euclidean_divide (xx, SCM_REAL_VALUE (y));
else if (SCM_FRACTIONP (y))
return scm_i_slow_exact_euclidean_divide (x, y);
else
@@ -1482,19 +1492,19 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0,
else
{
SCM q = scm_i_mkbig ();
- SCM r = scm_i_mkbig ();
+ scm_t_inum rr;
if (yy > 0)
- mpz_fdiv_qr_ui (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (r),
- SCM_I_BIG_MPZ (x), yy);
+ rr = mpz_fdiv_q_ui (SCM_I_BIG_MPZ (q),
+ SCM_I_BIG_MPZ (x), yy);
else
{
- mpz_fdiv_qr_ui (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (r),
- SCM_I_BIG_MPZ (x), -yy);
+ rr = mpz_fdiv_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));
}
scm_remember_upto_here_1 (x);
return scm_values (scm_list_2 (scm_i_normbig (q),
- scm_i_normbig (r)));
+ SCM_I_MAKINUM (rr)));
}
}
else if (SCM_BIGP (y))
@@ -1607,6 +1617,7 @@ SCM_PRIMITIVE_GENERIC (scm_centered_quotient, "centered-quotient", 2, 0, 0,
{
if (SCM_LIKELY (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);
@@ -1614,9 +1625,8 @@ SCM_PRIMITIVE_GENERIC (scm_centered_quotient, "centered-quotient", 2, 0, 0,
scm_num_overflow (s_scm_centered_quotient);
else
{
- scm_t_inum xx = SCM_I_INUM (x);
scm_t_inum qq = xx / yy;
- scm_t_inum rr = xx - qq * yy;
+ scm_t_inum rr = xx % yy;
if (SCM_LIKELY (xx > 0))
{
if (SCM_LIKELY (yy > 0))
@@ -1643,19 +1653,20 @@ SCM_PRIMITIVE_GENERIC (scm_centered_quotient, "centered-quotient", 2, 0, 0,
qq++;
}
}
- return SCM_I_MAKINUM (qq);
+ if (SCM_LIKELY (SCM_FIXABLE (qq)))
+ return SCM_I_MAKINUM (qq);
+ else
+ return scm_i_inum2big (qq);
}
}
else if (SCM_BIGP (y))
{
/* Pass a denormalized bignum version of x (even though it
can fit in a fixnum) to scm_i_bigint_centered_quotient */
- return scm_i_bigint_centered_quotient
- (scm_i_long2big (SCM_I_INUM (x)), y);
+ return scm_i_bigint_centered_quotient (scm_i_long2big (xx), y);
}
else if (SCM_REALP (y))
- return scm_i_inexact_centered_quotient
- (SCM_I_INUM (x), SCM_REAL_VALUE (y));
+ return scm_i_inexact_centered_quotient (xx, SCM_REAL_VALUE (y));
else if (SCM_FRACTIONP (y))
return scm_i_slow_exact_centered_quotient (x, y);
else
@@ -1669,6 +1680,8 @@ SCM_PRIMITIVE_GENERIC (scm_centered_quotient, "centered-quotient", 2, 0, 0,
scm_t_inum yy = SCM_I_INUM (y);
if (SCM_UNLIKELY (yy == 0))
scm_num_overflow (s_scm_centered_quotient);
+ else if (SCM_UNLIKELY (yy == 1))
+ return x;
else
{
SCM q = scm_i_mkbig ();
@@ -1833,6 +1846,7 @@ SCM_PRIMITIVE_GENERIC (scm_centered_remainder, "centered-remainder", 2, 0, 0,
{
if (SCM_LIKELY (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);
@@ -1840,7 +1854,6 @@ SCM_PRIMITIVE_GENERIC (scm_centered_remainder, "centered-remainder", 2, 0, 0,
scm_num_overflow (s_scm_centered_remainder);
else
{
- scm_t_inum xx = SCM_I_INUM (x);
scm_t_inum rr = xx % yy;
if (SCM_LIKELY (xx > 0))
{
@@ -1875,12 +1888,10 @@ SCM_PRIMITIVE_GENERIC (scm_centered_remainder, "centered-remainder", 2, 0, 0,
{
/* Pass a denormalized bignum version of x (even though it
can fit in a fixnum) to scm_i_bigint_centered_remainder */
- return scm_i_bigint_centered_remainder
- (scm_i_long2big (SCM_I_INUM (x)), y);
+ return scm_i_bigint_centered_remainder (scm_i_long2big (xx), y);
}
else if (SCM_REALP (y))
- return scm_i_inexact_centered_remainder
- (SCM_I_INUM (x), SCM_REAL_VALUE (y));
+ return scm_i_inexact_centered_remainder (xx, SCM_REAL_VALUE (y));
else if (SCM_FRACTIONP (y))
return scm_i_slow_exact_centered_remainder (x, y);
else
@@ -2062,6 +2073,7 @@ SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0,
{
if (SCM_LIKELY (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);
@@ -2069,9 +2081,10 @@ SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0,
scm_num_overflow (s_scm_centered_divide);
else
{
- scm_t_inum xx = SCM_I_INUM (x);
scm_t_inum qq = xx / yy;
- scm_t_inum rr = xx - qq * yy;
+ scm_t_inum rr = xx % yy;
+ SCM q;
+
if (SCM_LIKELY (xx > 0))
{
if (SCM_LIKELY (yy > 0))
@@ -2098,20 +2111,21 @@ SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0,
{ qq++; rr -= yy; }
}
}
- return scm_values (scm_list_2 (SCM_I_MAKINUM (qq),
- SCM_I_MAKINUM (rr)));
+ if (SCM_LIKELY (SCM_FIXABLE (qq)))
+ q = SCM_I_MAKINUM (qq);
+ else
+ q = scm_i_inum2big (qq);
+ return scm_values (scm_list_2 (q, SCM_I_MAKINUM (rr)));
}
}
else if (SCM_BIGP (y))
{
/* Pass a denormalized bignum version of x (even though it
can fit in a fixnum) to scm_i_bigint_centered_divide */
- return scm_i_bigint_centered_divide
- (scm_i_long2big (SCM_I_INUM (x)), y);
+ return scm_i_bigint_centered_divide (scm_i_long2big (xx), y);
}
else if (SCM_REALP (y))
- return scm_i_inexact_centered_divide
- (SCM_I_INUM (x), SCM_REAL_VALUE (y));
+ return scm_i_inexact_centered_divide (xx, SCM_REAL_VALUE (y));
else if (SCM_FRACTIONP (y))
return scm_i_slow_exact_centered_divide (x, y);
else