Implement `finite?' in core and fix R6RS `finite?' and `infinite?'

* libguile/numbers.c (scm_finite_p): Add new predicate `finite?' from
  R6RS to guile core, which returns #t if and only if its argument is
  neither infinite nor a NaN.  Note that this is not the same as (not
  (inf? x)) or (not (infinite? x)), since NaNs are neither finite nor
  infinite.

* test-suite/tests/numbers.test: Add test cases for `finite?'.

* module/rnrs/base.scm: Import `inf?' as `infinite?' instead of
  reimplementing it.  Previously, the R6RS implementation of
  `infinite?' did not detect non-real complex infinities, nor did it
  throw exceptions for non-numbers.  (Note that NaNs _are_ considered
  numbers by scheme, despite their name).

  Import `finite?' instead of reimplementing it.  Previously, the R6RS
  implementation of `finite?' returned #t for both NaNs and non-real
  complex infinities, in violation of R6RS.

* NEWS: Add NEWS entries, and reorganize existing numerics-related
  entries together under one subheading.

* doc/ref/api-data.texi (Real and Rational Numbers): Add docs for
  `finite?' and scm_finite_p.

diff --git a/NEWS b/NEWS
index 388f43d..757f783 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -10,18 +10,14 @@ latest prerelease, and a full NEWS corresponding to 1.8 -> 2.0.
 
 Changes in 1.9.15 (since the 1.9.14 prerelease):
 
-** Infinities are no longer integers.
+** Changes and bugfixes in numerics code
+
+*** Infinities are no longer integers.
 
 Following the R6RS, infinities (+inf.0 and -inf.0) are no longer
 considered to be integers.
 
-** New reader option: `hungry-eol-escapes'
-
-Guile's string syntax is more compatible with R6RS when the
-`hungry-eol-escapes' option is enabled.  See "String Syntax" in the
-manual, for more information.
-
-** `expt' and `integer-expt' changes when the base is 0
+*** `expt' and `integer-expt' changes when the base is 0
 
 While `(expt 0 0)' is still 1, and `(expt 0 N)' for N > 0 is still
 zero, `(expt 0 N)' for N < 0 is now a NaN value, and likewise for
@@ -29,6 +25,33 @@ 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.
 
+*** New procedure: `finite?'
+
+Add scm_finite_p `finite?' from R6RS to guile core, which returns #t
+if and only if its argument is neither infinite nor a NaN.  Note that
+this is not the same as (not (inf? x)) or (not (infinite? x)), since
+NaNs are neither finite nor infinite.
+
+*** R6RS base library changes
+
+**** `infinite?' changes
+
+`infinite?' now returns #t for non-real complex infinities, and throws
+exceptions for non-numbers.  (Note that NaNs _are_ considered numbers
+by scheme, despite their name).
+
+**** `finite?' changes
+
+`finite?' now returns #f for NaNs and non-real complex infinities, and
+throws exceptions for non-numbers.  (Note that NaNs _are_ considered
+numbers by scheme, despite their name).
+
+** New reader option: `hungry-eol-escapes'
+
+Guile's string syntax is more compatible with R6RS when the
+`hungry-eol-escapes' option is enabled.  See "String Syntax" in the
+manual, for more information.
+
 ** And of course, the usual collection of bugfixes
  
 Interested users should see the ChangeLog for more information.

diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 4835f30..fc253b0 100755 (executable)
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -549,7 +549,8 @@ 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?}.
+@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)
@@ -597,6 +598,12 @@ Return @code{#t} if @var{x} is either @samp{+inf.0} or @samp{-inf.0},
 Return @code{#t} if @var{x} is @samp{+nan.0}, @code{#f} otherwise.
 @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.
+@end deffn
+
 @deffn {Scheme Procedure} nan
 @deffnx {C Function} scm_nan ()
 Return NaN.

diff --git a/libguile/numbers.c b/libguile/numbers.c
index c1b1d98..d35bee0 100644 (file)
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -79,6 +79,10 @@
 typedef scm_t_signed_bits scm_t_inum;
 #define scm_from_inum(x) (scm_from_signed_integer (x))
 
+/* Tests to see if a C double is neither infinite nor a NaN.
+   TODO: if it's available, use C99's isfinite(x) instead */
+#define DOUBLE_IS_FINITE(x) (!isinf(x) && !isnan(x))
+
 \f
 
 /*
@@ -581,6 +585,24 @@ SCM_DEFINE (scm_even_p, "even?", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_finite_p, "finite?", 1, 0, 0,
+            (SCM x),
+           "Return @code{#t} if @var{x} is neither infinite\n"
+           "nor a NaN, @code{#f} otherwise.")
+#define FUNC_NAME s_scm_finite_p
+{
+  if (SCM_REALP (x))
+    return scm_from_bool (DOUBLE_IS_FINITE (SCM_REAL_VALUE (x)));
+  else if (SCM_COMPLEXP (x))
+    return scm_from_bool (DOUBLE_IS_FINITE (SCM_COMPLEX_REAL (x))
+                         && DOUBLE_IS_FINITE (SCM_COMPLEX_IMAG (x)));
+  else if (SCM_NUMBERP (x))
+    return SCM_BOOL_T;
+  else
+    SCM_WRONG_TYPE_ARG (1, x);
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_inf_p, "inf?", 1, 0, 0, 
             (SCM x),
            "Return @code{#t} if @var{x} is either @samp{+inf.0}\n"

diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm
index a6ae1b9..c7579c3 100644 (file)
--- a/module/rnrs/base.scm
+++ b/module/rnrs/base.scm
@@ -1,6 +1,6 @@
 ;;; base.scm --- The R6RS base library
 
-;;      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
@@ -76,6 +76,7 @@
   (import (rename (except (guile) error raise)
                   (quotient div) 
                   (modulo mod)
+                  (inf? infinite?)
                   (exact->inexact inexact)
                   (inexact->exact exact))
           (srfi srfi-11))
@@ -98,9 +99,6 @@
        (let ((sym (car syms)))
          (and (symbol? sym) (symbol=?-internal (cdr syms) sym)))))
 
- (define (infinite? x) (or (eqv? x +inf.0) (eqv? x -inf.0)))
- (define (finite? x) (not (infinite? x)))
-
  (define (exact-integer-sqrt x)
    (let* ((s (exact (floor (sqrt x)))) (e (- x (* s s)))) (values s e)))
 

diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 5ea4764..d9a75f3 100644 (file)
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -304,6 +304,32 @@
   (pass-if (not (even? (- (* 2 fixnum-min) 1))))
   (pass-if (even? (* 2 fixnum-min))))
 
+;;;
+;;; finite?
+;;;
+
+(with-test-prefix "finite?"
+  (pass-if (documented? finite?))
+  (pass-if (not (finite? (inf))))
+  (pass-if (not (finite? +inf.0)))
+  (pass-if (not (finite? -inf.0)))
+  (pass-if (not (finite? +inf.0+1i)))
+  (pass-if (not (finite? -inf.0+1i)))
+  (pass-if (not (finite? +1+inf.0i)))
+  (pass-if (not (finite? +1-inf.0i)))
+  (pass-if (not (finite? (nan))))
+  (pass-if (not (finite? +nan.0)))
+  (pass-if (not (finite? 1+nan.0i)))
+  (pass-if (not (finite? +nan.0+nan.0i)))
+  (pass-if (finite? 0))
+  (pass-if (finite? 0.0))
+  (pass-if (finite? -0.0))
+  (pass-if (finite? 42.0))
+  (pass-if (finite? 1/2))
+  (pass-if (finite? 42.0+700i))
+  (pass-if (finite? (+ fixnum-max 1)))
+  (pass-if (finite? (- fixnum-min 1))))
+
 ;;;
 ;;; inf? and inf
 ;;;