mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

equal?' and eqv?' are now equivalent for numbers

Browse source 
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.
This commit is contained in:
Mark H Weaver 2011-01-28 19:57:41 -05:00 • committed by Andy Wingo
parent c9cf90d474
commit 2e6e1933b4
4 changed files with 154 additions and 89 deletions
Download patch file Download diff file Expand all files Collapse all files

15
NEWS
View file

@ -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

102
libguile/eq.c
View file

@ -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
@ -21,6 +21,8 @@
# include <config.h>
#endif
#include <math.h>
#include "libguile/_scm.h"
#include "libguile/array-map.h"
#include "libguile/stackchk.h"
@ -118,7 +120,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,47 +201,25 @@ 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. */
if (SCM_CELL_TYPE (x) != SCM_CELL_TYPE (y))
{
/* 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))
switch (SCM_TYP7 (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)) {
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);
} 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_BOOL_F;
@ -309,19 +322,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))

34
libguile/numbers.c
View file

@ -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"

86
test-suite/tests/numbers.test
View file

@ -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)))
@ -1654,6 +1669,75 @@
(pass-if (not (equal? (ash 3 1023) +nan.0)))
(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)))))
;;;
;;; =
;;;