diff options
author | Mark H Weaver <mhw@netris.org> | 2011-02-02 03:14:13 -0500 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-02-02 21:28:18 +0100 |
commit | 9b9ef10cf06db2c0349fb6e0ce6a5c4fa48341d1 (patch) | |
tree | 70b310d2d8661ec08f655a9181e6df982e088bd5 /libguile/numbers.c | |
parent | 8deddc948d0b9cbd082d58e9c316a5380ea850a8 (diff) | |
download | guile-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.c | 49 |
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 */ |