>From 4983deef36933e7b6678a5c3412241c1f37d4cfb Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 26 Jan 2011 09:34:02 -0500 Subject: [PATCH] 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. --- NEWS | 39 +++++++++++++++++++++++++++++++-------- doc/ref/api-data.texi | 9 ++++++++- libguile/numbers.c | 22 ++++++++++++++++++++++ module/rnrs/base.scm | 6 ++---- test-suite/tests/numbers.test | 26 ++++++++++++++++++++++++++ 5 files changed, 89 insertions(+), 13 deletions(-) diff --git a/NEWS b/NEWS index 388f43d..757f783 100644 --- 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 --- 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 address@hidden 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) @@ -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 address@hidden {Scheme Procedure} finite? x address@hidden {C Function} scm_finite_p (x) +Return @code{#t} if @var{x} is neither infinite nor a NaN, address@hidden otherwise. address@hidden deffn + @deffn {Scheme Procedure} nan @deffnx {C Function} scm_nan () Return NaN. diff --git a/libguile/numbers.c b/libguile/numbers.c index c1b1d98..174ad23 100644 --- 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 SCM_I_CDBL_IS_FINITE(x) (!isinf(x) && !isnan(x)) + /* @@ -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 (SCM_I_CDBL_IS_FINITE (SCM_REAL_VALUE (x))); + else if (SCM_COMPLEXP (x)) + return scm_from_bool (SCM_I_CDBL_IS_FINITE (SCM_COMPLEX_REAL (x)) + && SCM_I_CDBL_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 --- 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 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -305,6 +305,32 @@ (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 ;;; -- 1.5.6.5