summaryrefslogtreecommitdiff
path: root/libguile/numbers.c
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2011-02-02 03:14:13 -0500
committerAndy Wingo <wingo@pobox.com>2011-02-02 21:28:18 +0100
commit9b9ef10cf06db2c0349fb6e0ce6a5c4fa48341d1 (patch)
tree70b310d2d8661ec08f655a9181e6df982e088bd5 /libguile/numbers.c
parent8deddc948d0b9cbd082d58e9c316a5380ea850a8 (diff)
downloadguile-9b9ef10cf06db2c0349fb6e0ce6a5c4fa48341d1.tar.gz
Improve handling of signed zeroes
* libguile/numbers.c (scm_abs): (abs -0.0) now returns 0.0. Previously it returned -0.0. Also move the REALP case above the BIGP case, and consider it SCM_LIKELY to be REALP if not INUMP. (scm_difference): (- 0 0.0) now returns -0.0. Previously it returned 0.0. Also make sure that (- 0 0.0+0.0i) will return -0.0-0.0i. * test-suite/tests/numbers.test (abs, -): Add test cases, and change some tests to use `eqv?' instead of `=', in order to test exactness and distinguish signed zeroes.
Diffstat (limited to 'libguile/numbers.c')
-rw-r--r--libguile/numbers.c49
1 files changed, 37 insertions, 12 deletions
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 090fb7591..9a7848a4c 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -745,6 +745,18 @@ SCM_PRIMITIVE_GENERIC (scm_abs, "abs", 1, 0, 0,
else
return scm_i_inum2big (-xx);
}
+ else if (SCM_LIKELY (SCM_REALP (x)))
+ {
+ double xx = SCM_REAL_VALUE (x);
+ /* If x is a NaN then xx<0 is false so we return x unchanged */
+ if (xx < 0.0)
+ return scm_from_double (-xx);
+ /* Handle signed zeroes properly */
+ else if (SCM_UNLIKELY (xx == 0.0))
+ return flo0;
+ else
+ return x;
+ }
else if (SCM_BIGP (x))
{
const int sgn = mpz_sgn (SCM_I_BIG_MPZ (x));
@@ -753,15 +765,6 @@ SCM_PRIMITIVE_GENERIC (scm_abs, "abs", 1, 0, 0,
else
return x;
}
- else if (SCM_REALP (x))
- {
- /* note that if x is a NaN then xx<0 is false so we return x unchanged */
- double xx = SCM_REAL_VALUE (x);
- if (xx < 0.0)
- return scm_from_double (-xx);
- else
- return x;
- }
else if (SCM_FRACTIONP (x))
{
if (scm_is_false (scm_negative_p (SCM_FRACTION_NUMERATOR (x))))
@@ -5758,13 +5761,35 @@ scm_difference (SCM x, SCM y)
else if (SCM_REALP (y))
{
scm_t_inum xx = SCM_I_INUM (x);
- return scm_from_double (xx - SCM_REAL_VALUE (y));
+
+ /*
+ * We need to handle x == exact 0
+ * specially because R6RS states that:
+ * (- 0.0) ==> -0.0 and
+ * (- 0.0 0.0) ==> 0.0
+ * and the scheme compiler changes
+ * (- 0.0) into (- 0 0.0)
+ * So we need to treat (- 0 0.0) like (- 0.0).
+ * At the C level, (-x) is different than (0.0 - x).
+ * (0.0 - 0.0) ==> 0.0, but (- 0.0) ==> -0.0.
+ */
+ if (xx == 0)
+ return scm_from_double (- SCM_REAL_VALUE (y));
+ else
+ return scm_from_double (xx - SCM_REAL_VALUE (y));
}
else if (SCM_COMPLEXP (y))
{
scm_t_inum xx = SCM_I_INUM (x);
- return scm_c_make_rectangular (xx - SCM_COMPLEX_REAL (y),
- - SCM_COMPLEX_IMAG (y));
+
+ /* We need to handle x == exact 0 specially.
+ See the comment above (for SCM_REALP (y)) */
+ if (xx == 0)
+ return scm_c_make_rectangular (- SCM_COMPLEX_REAL (y),
+ - SCM_COMPLEX_IMAG (y));
+ else
+ return scm_c_make_rectangular (xx - SCM_COMPLEX_REAL (y),
+ - SCM_COMPLEX_IMAG (y));
}
else if (SCM_FRACTIONP (y))
/* a - b/c = (ac - b) / c */