guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-14-143-g0


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-14-143-g074c414
Date: Sun, 30 Jan 2011 12:36:31 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=074c414e297ba4095d2398fac17842c56ad24b11

The branch, master has been updated
       via  074c414e297ba4095d2398fac17842c56ad24b11 (commit)
       via  8f2339c436ce4b9c606246cb341f2a5f35c1de26 (commit)
       via  c960e55600962c45be7e623859eddca3fad87783 (commit)
       via  2e6e1933b4ca26793741cc0ec0832978f10c0c99 (commit)
       via  c9cf90d474e5220f73851a8e4186baab476ddb15 (commit)
      from  41d82ac9904c883a0c281cd1a89c03d9d968a801 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 074c414e297ba4095d2398fac17842c56ad24b11
Author: Mark H Weaver <address@hidden>
Date:   Sat Jan 29 22:07:49 2011 -0500

    Fix GOOPS method compilation bug when no next-method exists
    
    * module/oop/goops/compile.scm (compute-cmethod): Fix a bug
      that caused the method compiler to barf while compiling a
      method that calls (next-method), if there is no applicable
      next method.

commit 8f2339c436ce4b9c606246cb341f2a5f35c1de26
Author: Mark H Weaver <address@hidden>
Date:   Fri Jan 28 23:42:01 2011 -0500

    Implement R6RS `real-valued?', `rational-valued?', `integer-valued?'
    
    * module/rnrs/base.scm (real-valued?, rational-valued?,
      integer-valued?): Implement in compliance with R6RS.
    
    * test-suite/tests/r6rs-base.test: Add test cases for
      `real-valued?', `rational-valued?', and `integer-valued?'.
    
    * NEWS: Add NEWS entries.

commit c960e55600962c45be7e623859eddca3fad87783
Author: Mark H Weaver <address@hidden>
Date:   Fri Jan 28 23:32:20 2011 -0500

    Infinities and NaNs are no longer rational
    
    * libguile/numbers.c (scm_rational_p): Return #f for infinities and
      NaNs, per R6RS.  Previously it returned #t for real infinities
      and NaNs.  They are still considered real by scm_real `real?'
      however, per R6RS.  Also simplify the code.
    
      (scm_real_p): New implementation to reflect the fact that the
      rationals and reals are no longer the same set.  Previously it just
      called scm_rational_p.
    
      (scm_integer_p): Simplify the code.
    
    * test-suite/tests/numbers.test: Add test cases for `rational?'
      and `real?' applied to infinities and NaNs.
    
    * doc/ref/api-data.texi (Real and Rational Numbers): Update docs to
      reflect the fact that infinities and NaNs are no longer rational, and
      that `real?'  no longer implies `rational?'.  Improve discussion of
      infinities and NaNs.
    
    * NEWS: Add NEWS entries, and combine with an earlier entry about
      infinities no longer being integers.

commit 2e6e1933b4ca26793741cc0ec0832978f10c0c99
Author: Mark H Weaver <address@hidden>
Date:   Fri Jan 28 19:57:41 2011 -0500

    `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.

commit c9cf90d474e5220f73851a8e4186baab476ddb15
Author: Mark H Weaver <address@hidden>
Date:   Fri Jan 28 19:13:47 2011 -0500

    Remove useless test and fix spelling errors
    
    * test-suite/tests/numbers.test: Remove test for lazy reduction bit of
      fractions, which was never implemented.  Fix some spelling errors.

-----------------------------------------------------------------------

Summary of changes:
 NEWS                            |   33 ++++++++++-
 doc/ref/api-data.texi           |   73 +++++++++++++-----------
 libguile/eq.c                   |  108 ++++++++++++++++++------------------
 libguile/numbers.c              |   74 ++++--------------------
 module/oop/goops/compile.scm    |    2 +-
 module/rnrs/base.scm            |   19 ++++---
 test-suite/tests/numbers.test   |  118 +++++++++++++++++++++++++++++++++------
 test-suite/tests/r6rs-base.test |   89 +++++++++++++++++++++++++++++-
 8 files changed, 336 insertions(+), 180 deletions(-)

diff --git a/NEWS b/NEWS
index 9938204..f45795e 100644
--- a/NEWS
+++ b/NEWS
@@ -12,10 +12,20 @@ Changes in 1.9.15 (since the 1.9.14 prerelease):
 
 ** Changes and bugfixes in numerics code
 
-*** Infinities are no longer integers.
+*** `eqv?' and `equal?' now compare numbers equivalently
 
-Following the R6RS, infinities (+inf.0 and -inf.0) are no longer
-considered to be integers.
+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.
 
 *** `expt' and `integer-expt' changes when the base is 0
 
@@ -25,6 +35,19 @@ integer-expt.  This is more correct, and conforming to R6RS, 
but seems
 to be incompatible with R5RS, which would return 0 for all non-zero
 values of N.
 
+*** Infinities are no longer integers, nor rationals
+
+scm_integer_p `integer?' and scm_rational_p `rational?' now return #f
+for infinities, per R6RS.  Previously they returned #t for real
+infinities.  The real infinities and NaNs are still considered real by
+scm_real `real?' however, per R6RS.
+
+*** NaNs are no longer rationals
+
+scm_rational_p `rational?' now returns #f for NaN values, per R6RS.
+Previously it returned #t for real NaN values.  They are still
+considered real by scm_real `real?' however, per R6RS.
+
 *** `inf?' and `nan?' now throw exceptions for non-reals
 
 The domain of `inf?' and `nan?' is the real numbers.  Guile now signals
@@ -53,6 +76,10 @@ by scheme, despite their name).
 throws exceptions for non-numbers.  (Note that NaNs _are_ considered
 numbers by scheme, despite their name).
 
+**** `real-valued?', `rational-valued?' and `integer-valued?' changes
+
+These predicates are now implemented in accordance with R6RS.
+
 ** New reader option: `hungry-eol-escapes'
 
 Guile's string syntax is more compatible with R6RS when the
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index a0ab258..4256e18 100755
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -492,10 +492,10 @@ are not rational, for example @m{\sqrt2, the square root 
of 2}, and
 @m{\pi,pi}.
 
 Guile can represent both exact and inexact rational numbers, but it
-can not represent irrational numbers.  Exact rationals are represented
-by storing the numerator and denominator as two exact integers.
-Inexact rationals are stored as floating point numbers using the C
-type @code{double}.
+cannot represent precise finite irrational numbers.  Exact rationals are
+represented by storing the numerator and denominator as two exact
+integers.  Inexact rationals are stored as floating point numbers using
+the C type @code{double}.
 
 Exact rationals are written as a fraction of integers.  There must be
 no whitespace around the slash:
@@ -518,26 +518,41 @@ example:
 4.0
 @end lisp
 
-The limited precision of Guile's encoding means that any ``real'' number
-in Guile can be written in a rational form, by multiplying and then dividing
-by sufficient powers of 10 (or in fact, 2).  For example,
address@hidden is the same as @minus{}142857931198 divided by
-100000000000000000.  In Guile's current incarnation, therefore, the
address@hidden 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 limited precision of Guile's encoding means that any finite ``real''
+number in Guile can be written in a rational form, by multiplying and
+then dividing by sufficient powers of 10 (or in fact, 2).  For example,
address@hidden is the same as @minus{}142857931198 divided
+by 100000000000000000.  In Guile's current incarnation, therefore, the
address@hidden and @code{real?} predicates are equivalent for finite
+numbers.
 
-The 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.
 
-Dividing zero by zero yields something that is not a number at all:
address@hidden  This is the special `not a number' value.
+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
address@hidden; @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} value with any number (including
+itself) using @code{=}, @code{<}, @code{>}, @code{<=} or @code{>=}
+always returns @code{#f}.  Although a @acronym{NaN} value is not
address@hidden to itself, it is both @code{eqv?} and @code{equal?} to itself
+and other @acronym{NaN} values.  However, the preferred way to test for
+them is by using @code{nan?}.
+
+The real @acronym{NaN} values and infinities are written @samp{+nan.0},
address@hidden and @samp{-inf.0}.  This syntax is also recognized by
address@hidden as an extension to the usual Scheme syntax.  These special
+values are considered by Scheme to be inexact real numbers but not
+rational.  Note that non-real complex numbers may also contain
+infinities or @acronym{NaN} values in their real or imaginary parts.  To
+test a real number to see if it is infinite, a @acronym{NaN} value, or
+neither, use @code{inf?}, @code{nan?}, or @code{finite?}, respectively.
+Every real number in Scheme belongs to precisely one of those three
+classes.
 
 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 +560,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
address@hidden  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
@@ -566,9 +574,6 @@ Return @code{#t} if @var{x} is a rational number, @code{#f} 
otherwise.
 Note that the set of integer values forms a subset of the set of
 rational numbers, i. e. the predicate will also be fulfilled if
 @var{x} is an integer number.
-
-Since Guile can not represent irrational numbers, every number
-satisfying @code{real?} also satisfies @code{rational?} in Guile.
 @end deffn
 
 @deffn {Scheme Procedure} rationalize x eps
@@ -607,12 +612,12 @@ NaN, @code{#f} otherwise.
 
 @deffn {Scheme Procedure} nan
 @deffnx {C Function} scm_nan ()
-Return NaN.
+Return @samp{+nan.0}, a @acronym{NaN} value.
 @end deffn
 
 @deffn {Scheme Procedure} inf
 @deffnx {C Function} scm_inf ()
-Return Inf.
+Return @samp{+inf.0}, positive infinity.
 @end deffn
 
 @deffn {Scheme Procedure} numerator x
diff --git a/libguile/eq.c b/libguile/eq.c
index 7502559..99b3488 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
@@ -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,48 +201,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 +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))
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 9998ab7..608cf7a 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"
@@ -3315,8 +3281,8 @@ SCM_DEFINE (scm_real_p, "real?", 1, 0, 0,
            "fulfilled if @var{x} is an integer number.")
 #define FUNC_NAME s_scm_real_p
 {
-  /* we can't represent irrational numbers. */
-  return scm_rational_p (x);
+  return scm_from_bool
+    (SCM_I_INUMP (x) || SCM_REALP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x));
 }
 #undef FUNC_NAME
 
@@ -3328,18 +3294,12 @@ SCM_DEFINE (scm_rational_p, "rational?", 1, 0, 0,
            "fulfilled if @var{x} is an integer number.")
 #define FUNC_NAME s_scm_rational_p
 {
-  if (SCM_I_INUMP (x))
-    return SCM_BOOL_T;
-  else if (SCM_IMP (x))
-    return SCM_BOOL_F;
-  else if (SCM_BIGP (x))
-    return SCM_BOOL_T;
-  else if (SCM_FRACTIONP (x))
+  if (SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))
     return SCM_BOOL_T;
   else if (SCM_REALP (x))
-    /* due to their limited precision, all floating point numbers are
-       rational as well. */
-    return SCM_BOOL_T;
+    /* due to their limited precision, finite floating point numbers are
+       rational as well. (finite means neither infinity nor a NaN) */
+    return scm_from_bool (DOUBLE_IS_FINITE (SCM_REAL_VALUE (x)));
   else
     return SCM_BOOL_F;
 }
@@ -3351,23 +3311,15 @@ SCM_DEFINE (scm_integer_p, "integer?", 1, 0, 0,
            "else.")
 #define FUNC_NAME s_scm_integer_p
 {
-  double r;
-  if (SCM_I_INUMP (x))
-    return SCM_BOOL_T;
-  if (SCM_IMP (x))
-    return SCM_BOOL_F;
-  if (SCM_BIGP (x))
+  if (SCM_I_INUMP (x) || SCM_BIGP (x))
     return SCM_BOOL_T;
-  if (!SCM_INEXACTP (x))
-    return SCM_BOOL_F;
-  if (SCM_COMPLEXP (x))
-    return SCM_BOOL_F;
-  r = SCM_REAL_VALUE (x);
-  if (isinf (r))
+  else if (SCM_REALP (x))
+    {
+      double val = SCM_REAL_VALUE (x);
+      return scm_from_bool (!isinf (val) && (val == floor (val)));
+    }
+  else
     return SCM_BOOL_F;
-  if (r == floor (r))
-    return SCM_BOOL_T;
-  return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
diff --git a/module/oop/goops/compile.scm b/module/oop/goops/compile.scm
index db1a160..ace89b4 100644
--- a/module/oop/goops/compile.scm
+++ b/module/oop/goops/compile.scm
@@ -48,7 +48,7 @@
   (let ((make-procedure (slot-ref (car methods) 'make-procedure)))
     (if make-procedure
         (make-procedure
-         (if (null? methods)
+         (if (null? (cdr methods))
              (lambda args
                (no-next-method (method-generic-function (car methods)) args))
              (compute-cmethod (cdr methods) types)))
diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm
index c7579c3..04a7e23 100644
--- a/module/rnrs/base.scm
+++ b/module/rnrs/base.scm
@@ -102,14 +102,17 @@
  (define (exact-integer-sqrt x)
    (let* ((s (exact (floor (sqrt x)))) (e (- x (* s s)))) (values s e)))
 
- ;; These definitions should be revisited, since the behavior of Guile's 
- ;; implementations of `integer?', `rational?', and `real?' (exported from this
- ;; library) is not entirely consistent with R6RS's requirements for those 
- ;; functions.
-
- (define integer-valued? integer?)
- (define rational-valued? rational?)
- (define real-valued? real?)
+ (define (real-valued? x)
+   (and (complex? x)
+        (zero? (imag-part x))))
+
+ (define (rational-valued? x)
+   (and (real-valued? x)
+        (rational? (real-part x))))
+
+ (define (integer-valued? x)
+   (and (rational-valued? x)
+        (= x (floor (real-part x)))))
 
  (define (vector-for-each proc . vecs)
    (apply for-each (cons proc (map vector->list vecs))))
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index f53cb34..36e3128 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -318,15 +318,15 @@
   (pass-if (not (finite? +inf.0)))
   (pass-if (not (finite? -inf.0)))
   (pass-if-exception
-   "complex numbers not in doman of finite?"
+   "complex numbers not in domain of finite?"
    exception:wrong-type-arg
    (finite? +inf.0+1i))
   (pass-if-exception
-   "complex numbers not in doman of finite? (2)"
+   "complex numbers not in domain of finite? (2)"
    exception:wrong-type-arg
    (finite? +1+inf.0i))
   (pass-if-exception
-   "complex numbers not in doman of finite? (3)"
+   "complex numbers not in domain of finite? (3)"
    exception:wrong-type-arg
    (finite? +1+1i))
   (pass-if (finite? 3+0i))
@@ -351,7 +351,7 @@
   ;; (pass-if (inf? (/ 1.0 0.0))
   ;; (pass-if (inf? (/ 1 0.0))
   (pass-if-exception
-   "complex numbers not in doman of inf?"
+   "complex numbers not in domain of inf?"
    exception:wrong-type-arg
    (inf? +1+inf.0i))
   (pass-if (inf? +inf.0+0i))
@@ -1505,6 +1505,11 @@
   (pass-if (real? (+ 1 fixnum-max)))
   (pass-if (real? (- 1 fixnum-min)))
   (pass-if (real? 1.3))
+  (pass-if (real? +inf.0))
+  (pass-if (real? -inf.0))
+  (pass-if (real? +nan.0))
+  (pass-if (not (real? +inf.0-inf.0i)))
+  (pass-if (not (real? +nan.0+nan.0i)))
   (pass-if (not (real? 3+4i)))
   (pass-if (not (real? #\a)))
   (pass-if (not (real? "a")))
@@ -1515,7 +1520,7 @@
   (pass-if (not (real? (current-input-port)))))
 
 ;;;
-;;; rational? (same as real? right now)
+;;; rational?
 ;;;
 
 (with-test-prefix "rational?"
@@ -1526,6 +1531,11 @@
   (pass-if (rational? (+ 1 fixnum-max)))
   (pass-if (rational? (- 1 fixnum-min)))
   (pass-if (rational? 1.3))
+  (pass-if (not (rational? +inf.0)))
+  (pass-if (not (rational? -inf.0)))
+  (pass-if (not (rational? +nan.0)))
+  (pass-if (not (rational? +inf.0-inf.0i)))
+  (pass-if (not (rational? +nan.0+nan.0i)))
   (pass-if (not (rational? 3+4i)))
   (pass-if (not (rational? #\a)))
   (pass-if (not (rational? "a")))
@@ -1605,12 +1615,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 +1653,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 +1680,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)))))
+
+;;;
 ;;; =
 ;;;
 
@@ -3386,15 +3480,3 @@
   (pass-if "-100i swings back to 45deg down"
     (eqv-loosely? +7.071-7.071i (sqrt -100.0i))))
 
-
-;;
-;; equal? 
-;; 
-
-
-(with-test-prefix "equal?"
-  (pass-if
-
-   ;; lazy reduction bit for rationals should not affect equal?
-   (equal? 1/2 ((lambda (x) (denominator x) x) 1/2))))
-   
diff --git a/test-suite/tests/r6rs-base.test b/test-suite/tests/r6rs-base.test
index a3603a1..1509b04 100644
--- a/test-suite/tests/r6rs-base.test
+++ b/test-suite/tests/r6rs-base.test
@@ -1,6 +1,6 @@
 ;;; r6rs-base.test --- Test suite for R6RS (rnrs base)
 
-;;      Copyright (C) 2010 Free Software Foundation, Inc.
+;;      Copyright (C) 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
@@ -85,3 +85,90 @@
   (pass-if "vector-map simple"
     (equal? '#(3 2 1) (vector-map (lambda (x) (- 4 x)) '#(1 2 3)))))
 
+(with-test-prefix "real-valued?"
+  (pass-if (real-valued? +nan.0))
+  (pass-if (real-valued? +nan.0+0i))
+  (pass-if (real-valued? +nan.0+0.0i))
+  (pass-if (real-valued? +inf.0))
+  (pass-if (real-valued? -inf.0))
+  (pass-if (real-valued? +inf.0+0.0i))
+  (pass-if (real-valued? -inf.0-0.0i))
+  (pass-if (real-valued? 3))
+  (pass-if (real-valued? -2.5))
+  (pass-if (real-valued? -2.5+0i))
+  (pass-if (real-valued? -2.5+0.0i))
+  (pass-if (real-valued? -2.5-0i))
+  (pass-if (real-valued? #e1e10))
+  (pass-if (real-valued? 1e200))
+  (pass-if (real-valued? 1e200+0.0i))
+  (pass-if (real-valued? 6/10))
+  (pass-if (real-valued? 6/10+0.0i))
+  (pass-if (real-valued? 6/10+0i))
+  (pass-if (real-valued? 6/3))
+  (pass-if (not (real-valued? 3+i)))
+  (pass-if (not (real-valued? -2.5+0.01i)))
+  (pass-if (not (real-valued? +nan.0+0.01i)))
+  (pass-if (not (real-valued? +nan.0+nan.0i)))
+  (pass-if (not (real-valued? +inf.0-0.01i)))
+  (pass-if (not (real-valued? +0.01i)))
+  (pass-if (not (real-valued? -inf.0i))))
+
+(with-test-prefix "rational-valued?"
+  (pass-if (not (rational-valued? +nan.0)))
+  (pass-if (not (rational-valued? +nan.0+0i)))
+  (pass-if (not (rational-valued? +nan.0+0.0i)))
+  (pass-if (not (rational-valued? +inf.0)))
+  (pass-if (not (rational-valued? -inf.0)))
+  (pass-if (not (rational-valued? +inf.0+0.0i)))
+  (pass-if (not (rational-valued? -inf.0-0.0i)))
+  (pass-if (rational-valued? 3))
+  (pass-if (rational-valued? -2.5))
+  (pass-if (rational-valued? -2.5+0i))
+  (pass-if (rational-valued? -2.5+0.0i))
+  (pass-if (rational-valued? -2.5-0i))
+  (pass-if (rational-valued? #e1e10))
+  (pass-if (rational-valued? 1e200))
+  (pass-if (rational-valued? 1e200+0.0i))
+  (pass-if (rational-valued? 6/10))
+  (pass-if (rational-valued? 6/10+0.0i))
+  (pass-if (rational-valued? 6/10+0i))
+  (pass-if (rational-valued? 6/3))
+  (pass-if (not (rational-valued? 3+i)))
+  (pass-if (not (rational-valued? -2.5+0.01i)))
+  (pass-if (not (rational-valued? +nan.0+0.01i)))
+  (pass-if (not (rational-valued? +nan.0+nan.0i)))
+  (pass-if (not (rational-valued? +inf.0-0.01i)))
+  (pass-if (not (rational-valued? +0.01i)))
+  (pass-if (not (rational-valued? -inf.0i))))
+
+(with-test-prefix "integer-valued?"
+  (pass-if (not (integer-valued? +nan.0)))
+  (pass-if (not (integer-valued? +nan.0+0i)))
+  (pass-if (not (integer-valued? +nan.0+0.0i)))
+  (pass-if (not (integer-valued? +inf.0)))
+  (pass-if (not (integer-valued? -inf.0)))
+  (pass-if (not (integer-valued? +inf.0+0.0i)))
+  (pass-if (not (integer-valued? -inf.0-0.0i)))
+  (pass-if (integer-valued? 3))
+  (pass-if (integer-valued? 3.0))
+  (pass-if (integer-valued? 3+0i))
+  (pass-if (integer-valued? 3+0.0i))
+  (pass-if (integer-valued? 8/4))
+  (pass-if (integer-valued? #e1e10))
+  (pass-if (integer-valued? 1e200))
+  (pass-if (integer-valued? 1e200+0.0i))
+  (pass-if (not (integer-valued? -2.5)))
+  (pass-if (not (integer-valued? -2.5+0i)))
+  (pass-if (not (integer-valued? -2.5+0.0i)))
+  (pass-if (not (integer-valued? -2.5-0i)))
+  (pass-if (not (integer-valued? 6/10)))
+  (pass-if (not (integer-valued? 6/10+0.0i)))
+  (pass-if (not (integer-valued? 6/10+0i)))
+  (pass-if (not (integer-valued? 3+i)))
+  (pass-if (not (integer-valued? -2.5+0.01i)))
+  (pass-if (not (integer-valued? +nan.0+0.01i)))
+  (pass-if (not (integer-valued? +nan.0+nan.0i)))
+  (pass-if (not (integer-valued? +inf.0-0.01i)))
+  (pass-if (not (integer-valued? +0.01i)))
+  (pass-if (not (integer-valued? -inf.0i))))
+


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]