From 31d0b8d63b388ce8eb331ad75954bdc7a0175feb Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 26 Jan 2011 15:57:08 -0500 Subject: [PATCH] equal? and eqv? are now equivalent for numbers * libguile/numbers.c (scm_real_equalp, scm_bigequal, scm_complex_equalp, scm_i_fraction_equalp): Move to eq.c. (scm_nan_p): Improve documentation string to mention the existence of non-real complex NaNs. * libguile/eq.c (scm_bigequal, scm_i_fraction_equalp): Do the same thing that `eqv?' does. (real_eqv): Test for NaNs using isnan(x) instead of (x != x), and use SCM_UNLIKELY for optimization. (scm_real_equalp): Do the same thing that `eqv?' does. Previously worked differently in some cases, e.g. when comparing signed zeroes or NaNs. For example, (equal? 0.0 -0.0) returned #t but (eqv? 0.0 -0.0) returned #f, and (equal? +nan.0 +nan.0) returned #f but (eqv? +nan.0 +nan.0) returned #t. (scm_complex_equalp): Do the same thing that `eqv?' does. Previously worked differently in some cases, e.g. when comparing signed zeroes or NaNs. * test-suite/tests/numbers.test: Add test cases for `eqv?' and `equal?'. Change existing test case for `(equal? +nan.0 +nan.0)' to expect #t instead of #f. * doc/ref/api-data.texi (Real and Rational Numbers): Improve the discussion on infinities and NaNs, and clarify the documentation for scm_nan_p `nan?' to mention the existence of non-real complex NaNs. * NEWS: Add NEWS entries. --- NEWS | 15 +++++++ doc/ref/api-data.texi | 50 +++++++++++++----------- libguile/eq.c | 44 ++++++++++++++++++--- libguile/numbers.c | 39 +----------------- test-suite/tests/numbers.test | 85 ++++++++++++++++++++++++++++++++++++++++- 5 files changed, 166 insertions(+), 67 deletions(-) diff --git a/NEWS b/NEWS index 757f783..436efe8 100644 --- a/NEWS +++ b/NEWS @@ -12,6 +12,21 @@ Changes in 1.9.15 (since the 1.9.14 prerelease): ** Changes and bugfixes in numerics code +*** `eqv?' and `equal?' now compare numbers equivalently + +scm_equal_p `equal?' now behaves equivalently to scm_eqv_p `eqv?' for +numeric values, per R5RS. Previously, equal? worked differently, +e.g. `(equal? 0.0 -0.0)' returned #t but `(eqv? 0.0 -0.0)' returned #f, +and `(equal? +nan.0 +nan.0)' returned #f but `(eqv? +nan.0 +nan.0)' +returned #t. + +*** `(equal? +nan.0 +nan.0)' now returns #t + +Previously, `(equal? +nan.0 +nan.0)' returned #f, although +`(let ((x +nan.0)) (equal? x x))' and `(eqv? +nan.0 +nan.0)' +both returned #t. R5RS requires that `equal?' behave like +`eqv?' when comparing numbers. + *** Infinities are no longer integers. Following the R6RS, infinities (+inf.0 and -inf.0) are no longer diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index fc253b0..b2c4b89 100755 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -526,18 +526,28 @@ by sufficient powers of 10 (or in fact, 2). For example, @code{rational?} and @code{real?} predicates are equivalent. -Dividing by an exact zero leads to a error message, as one might -expect. However, dividing by an inexact zero does not produce an -error. Instead, the result of the division is either plus or minus -infinity, depending on the sign of the divided number. - -The infinities are written @samp{+inf.0} and @samp{-inf.0}, -respectively. This syntax is also recognized by @code{read} as an +Dividing by an exact zero leads to a error message, as one might expect. +However, dividing by an inexact zero does not produce an error. +Instead, the result of the division is either plus or minus infinity, +depending on the sign of the divided number and the sign of the zero +divisor (some platforms support signed zeroes @samp{-0.0} and +@samp{+0.0}; @samp{0.0} is the same as @samp{+0.0}). + +Dividing zero by an inexact zero yields a @acronym{NaN} (`not a number') +value, although they are actually considered numbers by Scheme. +Attempts to compare a @acronym{NaN} with any number (including itself) +using @code{=}, @code{<}, @code{>}, @code{<=} or @code{>=} always +returns @code{#f}. Although @code{+nan.0} is not @code{=} to itself, it +is both @code{eqv?} and @code{equal?} to itself. The best way to test +for them is by using @code{nan?}, which also detects complex numbers +whose real or imaginary part is a @acronym{NaN}. + +These special values are written @samp{+nan.0}, @samp{+inf.0} and +@samp{-inf.0}. This syntax is also recognized by @code{read} as an extension to the usual Scheme syntax. The infinities are considered to -be inexact, non-integer values. - -Dividing zero by zero yields something that is not a number at all: -@samp{+nan.0}. This is the special `not a number' value. +be inexact, non-integer values. @acronym{NaN} values are considered to +be inexact and irrational. To test for numbers that are neither +infinite nor a @acronym{NaN}, use @code{finite?}. On platforms that follow @acronym{IEEE} 754 for their floating point arithmetic, the @samp{+inf.0}, @samp{-inf.0}, and @samp{+nan.0} values @@ -545,13 +555,6 @@ are implemented using the corresponding @acronym{IEEE} 754 values. They behave in arithmetic operations like @acronym{IEEE} 754 describes it, i.e., @code{(= +nan.0 +nan.0)} @result{} @code{#f}. -While @samp{+nan.0} is not @code{=} to itself, it is @code{eqv?} to -itself. - -To test for the special values, use the functions @code{inf?} and -@code{nan?}. To test for numbers than are neither infinite nor a NaN, -use @code{finite?}. - @deffn {Scheme Procedure} real? obj @deffnx {C Function} scm_real_p (obj) Return @code{#t} if @var{obj} is a real number, else @code{#f}. Note @@ -595,23 +598,24 @@ Return @code{#t} if @var{x} is either @samp{+inf.0} or @samp{-inf.0}, @deffn {Scheme Procedure} nan? x @deffnx {C Function} scm_nan_p (x) -Return @code{#t} if @var{x} is @samp{+nan.0}, @code{#f} otherwise. +Return @code{#t} if @var{x} is @samp{+nan.0}, or a complex number whose +real or imaginary part is @samp{+nan.0}. Otherwise return @code{#f}. @end deffn @deffn {Scheme Procedure} finite? x @deffnx {C Function} scm_finite_p (x) -Return @code{#t} if @var{x} is neither infinite nor a NaN, -@code{#f} otherwise. +Return @code{#t} if @var{x} is neither @code{inf?} nor @code{nan?}. +Otherwise return @code{#f}. @end deffn @deffn {Scheme Procedure} nan @deffnx {C Function} scm_nan () -Return NaN. +Return @samp{+nan.0}. @end deffn @deffn {Scheme Procedure} inf @deffnx {C Function} scm_inf () -Return Inf. +Return @samp{+inf.0}. @end deffn @deffn {Scheme Procedure} numerator x diff --git a/libguile/eq.c b/libguile/eq.c index dc548b8..e03021e 100644 --- a/libguile/eq.c +++ b/libguile/eq.c @@ -118,7 +118,40 @@ scm_eq_p (SCM x, SCM y) static int real_eqv (double x, double y) { - return !memcmp (&x, &y, sizeof(double)) || (x != x && y != y); + return !memcmp (&x, &y, sizeof(double)) + || (SCM_UNLIKELY (isnan (x)) && SCM_UNLIKELY (isnan (y))); +} + +SCM +scm_real_equalp (SCM x, SCM y) +{ + return scm_from_bool (real_eqv (SCM_REAL_VALUE (x), + SCM_REAL_VALUE (y))); +} + +SCM +scm_bigequal (SCM x, SCM y) +{ + return scm_from_bool (scm_i_bigcmp (x, y) == 0); +} + +SCM +scm_complex_equalp (SCM x, SCM y) +{ + return scm_from_bool (real_eqv (SCM_COMPLEX_REAL (x), + SCM_COMPLEX_REAL (y)) + && real_eqv (SCM_COMPLEX_IMAG (x), + SCM_COMPLEX_IMAG (y))); +} + +SCM +scm_i_fraction_equalp (SCM x, SCM y) +{ + return scm_from_bool + (scm_is_true (scm_equal_p (SCM_FRACTION_NUMERATOR (x), + SCM_FRACTION_NUMERATOR (y))) + && scm_is_true (scm_equal_p (SCM_FRACTION_DENOMINATOR (x), + SCM_FRACTION_DENOMINATOR (y)))); } static SCM scm_i_eqv_p (SCM x, SCM y, SCM rest); @@ -197,16 +230,13 @@ SCM scm_eqv_p (SCM x, SCM y) if (SCM_NUMP (x)) { if (SCM_BIGP (x)) { - return scm_from_bool (scm_i_bigcmp (x, y) == 0); + return scm_bigequal (x, y); } else if (SCM_REALP (x)) { - return scm_from_bool (real_eqv (SCM_REAL_VALUE (x), SCM_REAL_VALUE (y))); + return scm_real_equalp (x, y); } else if (SCM_FRACTIONP (x)) { return scm_i_fraction_equalp (x, y); } else { /* complex */ - return scm_from_bool (real_eqv (SCM_COMPLEX_REAL (x), - SCM_COMPLEX_REAL (y)) - && real_eqv (SCM_COMPLEX_IMAG (x), - SCM_COMPLEX_IMAG (y))); + return scm_complex_equalp (x, y); } } return SCM_BOOL_F; diff --git a/libguile/numbers.c b/libguile/numbers.c index e25242f..7b00ba9 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -634,8 +634,9 @@ SCM_DEFINE (scm_inf_p, "inf?", 1, 0, 0, SCM_DEFINE (scm_nan_p, "nan?", 1, 0, 0, (SCM n), - "Return @code{#t} if @var{n} is a NaN, @code{#f}\n" - "otherwise.") + "Return @code{#t} if @var{x} is @samp{+nan.0},\n" + "or a complex number whose real or imaginary part\n" + "is @samp{+nan.0}. Otherwise return @code{#f}.") #define FUNC_NAME s_scm_nan_p { if (SCM_REALP (n)) @@ -3254,40 +3255,6 @@ SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0, /*** END strs->nums ***/ -SCM -scm_bigequal (SCM x, SCM y) -{ - int result = mpz_cmp (SCM_I_BIG_MPZ (x), SCM_I_BIG_MPZ (y)); - scm_remember_upto_here_2 (x, y); - return scm_from_bool (0 == result); -} - -SCM -scm_real_equalp (SCM x, SCM y) -{ - return scm_from_bool (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y)); -} - -SCM -scm_complex_equalp (SCM x, SCM y) -{ - return scm_from_bool (SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y) - && SCM_COMPLEX_IMAG (x) == SCM_COMPLEX_IMAG (y)); -} - -SCM -scm_i_fraction_equalp (SCM x, SCM y) -{ - if (scm_is_false (scm_equal_p (SCM_FRACTION_NUMERATOR (x), - SCM_FRACTION_NUMERATOR (y))) - || scm_is_false (scm_equal_p (SCM_FRACTION_DENOMINATOR (x), - SCM_FRACTION_DENOMINATOR (y)))) - return SCM_BOOL_F; - else - return SCM_BOOL_T; -} - - SCM_DEFINE (scm_number_p, "number?", 1, 0, 0, (SCM x), "Return @code{#t} if @var{x} is a number, @code{#f}\n" diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 27de045..7b0b73f 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -1594,12 +1594,24 @@ (with-test-prefix "equal?" (pass-if (documented? equal?)) + + ;; The following test will fail on platforms + ;; without distinct signed zeroes 0.0 and -0.0. + (pass-if (not (equal? 0.0 -0.0))) + (pass-if (equal? 0 0)) (pass-if (equal? 7 7)) (pass-if (equal? -7 -7)) (pass-if (equal? (+ 1 fixnum-max) (+ 1 fixnum-max))) (pass-if (equal? (- fixnum-min 1) (- fixnum-min 1))) + (pass-if (equal? 0.0 0.0)) + (pass-if (equal? -0.0 -0.0)) (pass-if (not (equal? 0 1))) + (pass-if (not (equal? 0 0.0))) + (pass-if (not (equal? 1 1.0))) + (pass-if (not (equal? 0.0 0))) + (pass-if (not (equal? 1.0 1))) + (pass-if (not (equal? -1.0 -1))) (pass-if (not (equal? fixnum-max (+ 1 fixnum-max)))) (pass-if (not (equal? (+ 1 fixnum-max) fixnum-max))) (pass-if (not (equal? (+ 1 fixnum-max) (+ 2 fixnum-max)))) @@ -1620,7 +1632,9 @@ (pass-if (not (equal? (- (ash 1 1024)) -inf.0))) (pass-if (not (equal? -inf.0 (- (ash 1 1024))))) - (pass-if (not (equal? +nan.0 +nan.0))) + (pass-if (equal? +nan.0 +nan.0)) + (pass-if (not (equal? +nan.0 0.0+nan.0i))) + (pass-if (not (equal? 0 +nan.0))) (pass-if (not (equal? +nan.0 0))) (pass-if (not (equal? 1 +nan.0))) @@ -1644,6 +1658,75 @@ (pass-if (not (equal? +nan.0 (ash 3 1023))))) ;;; +;;; eqv? +;;; + +(with-test-prefix "eqv?" + (pass-if (documented? eqv?)) + + ;; The following test will fail on platforms + ;; without distinct signed zeroes 0.0 and -0.0. + (pass-if (not (eqv? 0.0 -0.0))) + + (pass-if (eqv? 0 0)) + (pass-if (eqv? 7 7)) + (pass-if (eqv? -7 -7)) + (pass-if (eqv? (+ 1 fixnum-max) (+ 1 fixnum-max))) + (pass-if (eqv? (- fixnum-min 1) (- fixnum-min 1))) + (pass-if (eqv? 0.0 0.0)) + (pass-if (eqv? -0.0 -0.0)) + (pass-if (not (eqv? 0 1))) + (pass-if (not (eqv? 0 0.0))) + (pass-if (not (eqv? 1 1.0))) + (pass-if (not (eqv? 0.0 0))) + (pass-if (not (eqv? 1.0 1))) + (pass-if (not (eqv? -1.0 -1))) + (pass-if (not (eqv? fixnum-max (+ 1 fixnum-max)))) + (pass-if (not (eqv? (+ 1 fixnum-max) fixnum-max))) + (pass-if (not (eqv? (+ 1 fixnum-max) (+ 2 fixnum-max)))) + (pass-if (not (eqv? fixnum-min (- fixnum-min 1)))) + (pass-if (not (eqv? (- fixnum-min 1) fixnum-min))) + (pass-if (not (eqv? (- fixnum-min 1) (- fixnum-min 2)))) + (pass-if (not (eqv? (+ fixnum-max 1) (- fixnum-min 1)))) + + (pass-if (not (eqv? (ash 1 256) +inf.0))) + (pass-if (not (eqv? +inf.0 (ash 1 256)))) + (pass-if (not (eqv? (ash 1 256) -inf.0))) + (pass-if (not (eqv? -inf.0 (ash 1 256)))) + + ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make + ;; sure we've avoided that + (pass-if (not (eqv? (ash 1 1024) +inf.0))) + (pass-if (not (eqv? +inf.0 (ash 1 1024)))) + (pass-if (not (eqv? (- (ash 1 1024)) -inf.0))) + (pass-if (not (eqv? -inf.0 (- (ash 1 1024))))) + + (pass-if (eqv? +nan.0 +nan.0)) + (pass-if (not (eqv? +nan.0 0.0+nan.0i))) + + (pass-if (not (eqv? 0 +nan.0))) + (pass-if (not (eqv? +nan.0 0))) + (pass-if (not (eqv? 1 +nan.0))) + (pass-if (not (eqv? +nan.0 1))) + (pass-if (not (eqv? -1 +nan.0))) + (pass-if (not (eqv? +nan.0 -1))) + + (pass-if (not (eqv? (ash 1 256) +nan.0))) + (pass-if (not (eqv? +nan.0 (ash 1 256)))) + (pass-if (not (eqv? (- (ash 1 256)) +nan.0))) + (pass-if (not (eqv? +nan.0 (- (ash 1 256))))) + + (pass-if (not (eqv? (ash 1 8192) +nan.0))) + (pass-if (not (eqv? +nan.0 (ash 1 8192)))) + (pass-if (not (eqv? (- (ash 1 8192)) +nan.0))) + (pass-if (not (eqv? +nan.0 (- (ash 1 8192))))) + + ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make + ;; sure we've avoided that + (pass-if (not (eqv? (ash 3 1023) +nan.0))) + (pass-if (not (eqv? +nan.0 (ash 3 1023))))) + +;;; ;;; = ;;; -- 1.5.6.5