From 0a7ce98bd8bfc34176ca78ad91a29c5b2087db0f Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 26 Jan 2011 04:20:32 -0500 Subject: [PATCH] equal? and eqv? equivalent for numbers, and (not (eqv? +nan.0 +nan.0)) * libguile/numbers.c (scm_real_equalp, scm_bigequal, scm_complex_equalp, scm_i_fraction_equalp): Move to eq.c. * libguile/eq.c (scm_bigequal, scm_i_fraction_equalp): Do the same thing that `eqv?' does. (scm_real_equalp): Do the same thing that `eqv?' does. Previously worked differently in some cases, e.g. when comparing signed zeroes. Also return #f if either argument is a NaN, per R6RS. Previously returned #t if both were real NaNs. (scm_complex_equalp): Do the same thing that `eqv?' does. Previously worked differently in some cases, e.g. when comparing signed zeroes. Also return #f if either argument is a NaN, per R6RS. (real_eqv): Return false if either argument is a NaN, per R6RS. Previously returned true if both were NaNs. * test-suite/standalone/test-conversion.c (test_from_double): Modify NaN test to use scm_nan_p instead of scm_eqv_p, since scm_eqv_p can no longer be used to detect NaNs. * test-suite/tests/numbers.test: Add test cases for `eqv?' and `equal?'. * doc/ref/api-data.texi (Real and Rational Numbers): Update docs to reflect changes in NaN handling, and improve discussion on infinities and NaNs. * NEWS: Add NEWS entries regarding changes in NaN handling and equivalence of `equal?' and `eqv?'. --- NEWS | 13 ++++++ doc/ref/api-data.texi | 37 +++++++++------- libguile/eq.c | 42 +++++++++++++++--- libguile/numbers.c | 34 --------------- test-suite/standalone/test-conversion.c | 8 +++- test-suite/tests/numbers.test | 71 +++++++++++++++++++++++++++++++ 6 files changed, 145 insertions(+), 60 deletions(-) diff --git a/NEWS b/NEWS index 757f783..d5fdb08 100644 --- a/NEWS +++ b/NEWS @@ -12,6 +12,19 @@ Changes in 1.9.15 (since the 1.9.14 prerelease): ** Changes and bugfixes in numerics code +*** `eqv?' and `equal?' now handle 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. + +*** NaNs are no longer `eqv?' nor `equal?' + +scm_eqv_p `eqv?', scm_equal_p `equal?' and scm_real_equalp now return +#f if either argument is a NaN, per R6RS. Previously, they returned +#t if both were real NaNs, or both were non-real complex NaNs. Use +scm_nan_p `nan?' to test for NaNs. + *** 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..55457cd 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}, +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}). + +The real infinities are written @samp{+inf.0} and @samp{-inf.0}, respectively. 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. +be inexact, non-integer values. You can test for them using +@code{inf?}. + +Dividing zero by an inexact zero yields a NaN (`not a number') value, +although they are actually considered numbers by Scheme. NaNs are +unequal to all numbers, including themselves. Attempts to compare them +with any number using @code{equal?}, @code{eqv?}, @code{=}, @code{<}, +@code{>}, @code{<=} or @code{>=} always returns @code{#f}. You can test +for them using @code{nan?}. -Dividing zero by zero yields something that is not a number at all: -@samp{+nan.0}. This is the special `not a number' value. +To test for numbers that are neither infinite nor a 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,7 +598,7 @@ 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 a NaN, @code{#f} otherwise. @end deffn @deffn {Scheme Procedure} finite? x diff --git a/libguile/eq.c b/libguile/eq.c index dc548b8..cbd2ceb 100644 --- a/libguile/eq.c +++ b/libguile/eq.c @@ -118,7 +118,38 @@ 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)) && (x == x); +} + +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 +228,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..166503a 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -3254,40 +3254,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/standalone/test-conversion.c b/test-suite/standalone/test-conversion.c index 124ae9d..cce4258 100644 --- a/test-suite/standalone/test-conversion.c +++ b/test-suite/standalone/test-conversion.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2007, 2008, 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 @@ -866,7 +866,11 @@ test_from_double () test_9 (0.1, "0.1"); test_9 (guile_Inf, "+inf.0"); test_9 (-guile_Inf, "-inf.0"); - test_9 (guile_NaN, "+nan.0"); + if (scm_is_false (scm_nan_p (scm_from_double (guile_NaN)))) + { + fprintf (stderr, "fail: scm_nan_p (scm_from_double (+nan.0))\n"); + exit (EXIT_FAILURE); + } } typedef struct { diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 27de045..1528f52 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -1599,7 +1599,15 @@ (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.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)))) @@ -1644,6 +1652,69 @@ (pass-if (not (equal? +nan.0 (ash 3 1023))))) ;;; +;;; eqv? +;;; + +(with-test-prefix "eqv?" + (pass-if (documented? eqv?)) + (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.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 (not (eqv? +nan.0 +nan.0))) + (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