>From 3afeb53165c69f95120336a5b6cbb83a810be1e9 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 28 Jan 2011 19:57:41 -0500 Subject: [PATCH] `equal?' and `eqv?' are now equivalent for numbers Change `equal?' to work like `eqv?' for numbers. Previously they 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. * libguile/numbers.c (scm_real_equalp, scm_bigequal, scm_complex_equalp, scm_i_fraction_equalp): Move to eq.c. * libguile/eq.c (scm_real_equalp): Compare flonums using real_eqv instead of ==, so that NaNs are now considered equal, and to distinguish signed zeroes. (scm_complex_equalp): Compare real and imaginary components using real_eqv instead of ==, so that NaNs are now considered equal, and to distinguish signed zeroes. (scm_bigequal): Use scm_i_bigcmp instead of duplicating it. (real_eqv): Test for NaNs using isnan(x) instead of (x != x), and use SCM_UNLIKELY for optimization. (scm_eqv_p): Use scm_bigequal, scm_real_equalp, scm_complex_equalp, and scm_i_fraction_equalp to compare numbers, instead of inline code. Those predicates now do what scm_eqv_p formerly did internally. Replace if statements with switch statements, as is done in scm_equal_p. Remove useless code to check equality of fractions with different SCM_CELL_TYPEs; this was for a tentative "lazy reduction bit" which was never developed. (scm_eqv_p, scm_equal_p): Remove useless code to check equality between inexact reals and non-real complex numbers with zero imaginary part. Such numbers do not exist, because the current code is careful to never create them. * 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. * NEWS: Add NEWS entries. --- NEWS | 15 ++++++ libguile/eq.c | 106 ++++++++++++++++++++--------------------- libguile/numbers.c | 34 ------------- test-suite/tests/numbers.test | 86 +++++++++++++++++++++++++++++++++- 4 files changed, 152 insertions(+), 89 deletions(-) diff --git a/NEWS b/NEWS index 9938204..2979849 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/libguile/eq.c b/libguile/eq.c index 7502559..00abdd8 100644 --- a/libguile/eq.c +++ b/libguile/eq.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001,2003, 2004, 2006, 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001,2003, 2004, 2006, 2009, 2010, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -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); @@ -166,48 +199,26 @@ SCM scm_eqv_p (SCM x, SCM y) return SCM_BOOL_F; if (SCM_IMP (y)) return SCM_BOOL_F; - /* this ensures that types and scm_length are the same. */ + /* this ensures that types and scm_length are the same. */ if (SCM_CELL_TYPE (x) != SCM_CELL_TYPE (y)) + return SCM_BOOL_F; + switch (SCM_TYP7 (x)) { - /* fractions use 0x10000 as a flag (at the suggestion of Marius Vollmer), - but this checks the entire type word, so fractions may be accidentally - flagged here as unequal. Perhaps I should use the 4th double_cell word? - */ - - /* treat mixes of real and complex types specially */ - if (SCM_INEXACTP (x)) - { - if (SCM_REALP (x)) - return scm_from_bool (SCM_COMPLEXP (y) - && real_eqv (SCM_REAL_VALUE (x), - SCM_COMPLEX_REAL (y)) - && SCM_COMPLEX_IMAG (y) == 0.0); - else - return scm_from_bool (SCM_REALP (y) - && real_eqv (SCM_COMPLEX_REAL (x), - SCM_REAL_VALUE (y)) - && SCM_COMPLEX_IMAG (x) == 0.0); - } - - if (SCM_FRACTIONP (x) && SCM_FRACTIONP (y)) - return scm_i_fraction_equalp (x, y); - return SCM_BOOL_F; - } - if (SCM_NUMP (x)) - { - if (SCM_BIGP (x)) { - return scm_from_bool (scm_i_bigcmp (x, y) == 0); - } else if (SCM_REALP (x)) { - return scm_from_bool (real_eqv (SCM_REAL_VALUE (x), SCM_REAL_VALUE (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))); - } + default: + break; + case scm_tc7_number: + switch SCM_TYP16 (x) + { + case scm_tc16_big: + return scm_bigequal (x, y); + case scm_tc16_real: + return scm_real_equalp (x, y); + case scm_tc16_complex: + return scm_complex_equalp (x, y); + case scm_tc16_fraction: + return scm_i_fraction_equalp (x, y); + } } return SCM_BOOL_F; } @@ -309,19 +320,6 @@ scm_equal_p (SCM x, SCM y) /* This ensures that types and scm_length are the same. */ if (SCM_CELL_TYPE (x) != SCM_CELL_TYPE (y)) { - /* treat mixes of real and complex types specially */ - if (SCM_INEXACTP (x) && SCM_INEXACTP (y)) - { - if (SCM_REALP (x)) - return scm_from_bool (SCM_COMPLEXP (y) - && SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y) - && SCM_COMPLEX_IMAG (y) == 0.0); - else - return scm_from_bool (SCM_REALP (y) - && SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y) - && SCM_COMPLEX_IMAG (x) == 0.0); - } - /* Vectors can be equal to one-dimensional arrays. */ if (scm_is_array (x) && scm_is_array (y)) diff --git a/libguile/numbers.c b/libguile/numbers.c index 9998ab7..8513fea 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -3249,40 +3249,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 4f30f6c..d116b6f 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -1605,12 +1605,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)))) @@ -1631,7 +1643,10 @@ (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 (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))) @@ -1655,6 +1670,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