From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Mark H Weaver Newsgroups: gmane.lisp.guile.devel Subject: [PATCH] Handle products with exact 0 differently, etc Date: Tue, 01 Feb 2011 07:09:39 -0500 Message-ID: <87ipx4vtvg.fsf@yeeloong.netris.org> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1296562223 12295 80.91.229.12 (1 Feb 2011 12:10:23 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Tue, 1 Feb 2011 12:10:23 +0000 (UTC) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Tue Feb 01 13:10:18 2011 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1PkF3b-0004Mq-KZ for guile-devel@m.gmane.org; Tue, 01 Feb 2011 13:10:14 +0100 Original-Received: from localhost ([127.0.0.1]:52545 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PkF3a-0001Ao-PU for guile-devel@m.gmane.org; Tue, 01 Feb 2011 07:10:02 -0500 Original-Received: from [140.186.70.92] (port=51103 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PkF3U-00019T-Sn for guile-devel@gnu.org; Tue, 01 Feb 2011 07:10:00 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PkF3R-0005gq-I1 for guile-devel@gnu.org; Tue, 01 Feb 2011 07:09:56 -0500 Original-Received: from world.peace.net ([216.204.32.208]:37109) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PkF3Q-0005gh-R9 for guile-devel@gnu.org; Tue, 01 Feb 2011 07:09:53 -0500 Original-Received: from ip68-9-118-38.ri.ri.cox.net ([68.9.118.38] helo=freedomincluded) by world.peace.net with esmtpa (Exim 4.69) (envelope-from ) id 1PkF3F-0005um-4U; Tue, 01 Feb 2011 07:09:41 -0500 Original-Received: from mhw by freedomincluded with local (Exim 4.69) (envelope-from ) id 1PkF3D-0007Xz-Qe; Tue, 01 Feb 2011 07:09:39 -0500 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 216.204.32.208 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:11483 Archived-At: --=-=-= Here's another batch of numerics patches. The most important one changes the way products involving exact 0 are handled: * libguile/numbers.c (scm_product): Handle exact 0 differently. A product containing an exact 0 now returns an exact 0 if and only if the other arguments are all exact. An inexact zero is returned if and only if the other arguments are all finite but not all exact. If an infinite or NaN value is present, a NaN value is returned. Previously, any product containing an exact 0 yielded an exact 0, regardless of the other arguments. A note on the rationale for (* 0 0.0) returning 0.0 and not exact 0: The exactness propagation rules allow us to return an exact result in the presence of inexact arguments only if the values of the inexact arguments do not affect the result. In this case, the value of the inexact argument _does_ affect the result, because an infinite or NaN value causes the result to be a NaN. A note on the rationale for (* 0 +inf.0) being a NaN and not exact 0: The R6RS requires that (/ 0 0.0) return a NaN value, and that (/ 0.0) return +inf.0. We would like (/ x y) to be the same as (* x (/ y)), and in particular, for (/ 0 0.0) to be the same as (* 0 (/ 0.0)), which reduces to (* 0 +inf.0). Therefore (* 0 +inf.0) should return a NaN. Best, Mark --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Fix-bugs-in-rationalize.patch Content-Description: Fix bugs in `rationalize' >From d4a0dfbaa775f6268a20fde2161911c5ce12e9a9 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 1 Feb 2011 05:19:24 -0500 Subject: [PATCH] Fix bugs in `rationalize' * libguile/numbers.c (scm_rationalize): Fix bugs. Previously, it returned exact integers unmodified, although that was incorrect if the epsilon was at least 1 or inexact, e.g. (rationalize 4 1) should return 3 per R5RS and R6RS, but previously it returned 4. Also handle cases involving infinities and NaNs properly, per R6RS. * test-suite/tests/numbers.test: Add test cases for `rationalize'. * NEWS: Add NEWS entry --- NEWS | 8 ++++++ libguile/numbers.c | 52 +++++++++++++++++++++++++++++++--------- test-suite/tests/numbers.test | 37 +++++++++++++++++++++++++++++ 3 files changed, 85 insertions(+), 12 deletions(-) diff --git a/NEWS b/NEWS index 2ba79a6..3769b81 100644 --- a/NEWS +++ b/NEWS @@ -169,6 +169,14 @@ an error when a non-real number or non-number is passed to these procedures. (Note that NaNs _are_ considered numbers by scheme, despite their name). +*** `rationalize' bugfixes and changes + +Fixed bugs in scm_rationalize `rationalize'. Previously, it returned +exact integers unmodified, although that was incorrect if the epsilon +was at least 1 or inexact, e.g. (rationalize 4 1) should return 3 per +R5RS and R6RS, but previously it returned 4. It also now handles +cases involving infinities and NaNs properly, per R6RS. + *** New procedure: `finite?' Add scm_finite_p `finite?' from R6RS to guile core, which returns #t diff --git a/libguile/numbers.c b/libguile/numbers.c index d08d15f..d4380dd 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -7267,11 +7267,46 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, "@end lisp") #define FUNC_NAME s_scm_rationalize { - if (SCM_I_INUMP (x)) - return x; - else if (SCM_BIGP (x)) + SCM_ASSERT_TYPE (scm_is_real (x), x, SCM_ARG1, FUNC_NAME, "real"); + SCM_ASSERT_TYPE (scm_is_real (eps), eps, SCM_ARG2, FUNC_NAME, "real"); + eps = scm_abs (eps); + if (scm_is_false (scm_positive_p (eps))) + { + /* eps is either zero or a NaN */ + if (scm_is_true (scm_nan_p (eps))) + return scm_nan (); + else if (SCM_INEXACTP (eps)) + return scm_exact_to_inexact (x); + else + return x; + } + else if (scm_is_false (scm_finite_p (eps))) + { + if (scm_is_true (scm_finite_p (x))) + return flo0; + else + return scm_nan (); + } + else if (scm_is_false (scm_finite_p (x))) /* checks for both inf and nan */ return x; - else if ((SCM_REALP (x)) || SCM_FRACTIONP (x)) + else if (scm_is_false (scm_less_p (scm_floor (scm_sum (x, eps)), + scm_ceiling (scm_difference (x, eps))))) + { + /* There's an integer within range; we want the one closest to zero */ + if (scm_is_false (scm_less_p (eps, scm_abs (x)))) + { + /* zero is within range */ + if (SCM_INEXACTP (x) || SCM_INEXACTP (eps)) + return flo0; + else + return SCM_INUM0; + } + else if (scm_is_true (scm_positive_p (x))) + return scm_ceiling (scm_difference (x, eps)); + else + return scm_floor (scm_sum (x, eps)); + } + else { /* Use continued fractions to find closest ratio. All arithmetic is done with exact numbers. @@ -7285,9 +7320,6 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, SCM rx; int i = 0; - if (scm_is_true (scm_num_eq_p (ex, int_part))) - return ex; - ex = scm_difference (ex, int_part); /* x = x-int_part */ rx = scm_divide (ex, SCM_UNDEFINED); /* rx = 1/x */ @@ -7296,7 +7328,6 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, converges after less than a dozen iterations. */ - eps = scm_abs (eps); while (++i < 1000000) { a = scm_sum (scm_product (a1, tt), a2); /* a = a1*tt + a2 */ @@ -7307,8 +7338,7 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, eps))) /* abs(x-a/b) <= eps */ { SCM res = scm_sum (int_part, scm_divide (a, b)); - if (scm_is_false (scm_exact_p (x)) - || scm_is_false (scm_exact_p (eps))) + if (SCM_INEXACTP (x) || SCM_INEXACTP (eps)) return scm_exact_to_inexact (res); else return res; @@ -7323,8 +7353,6 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, } scm_num_overflow (s_scm_rationalize); } - else - SCM_WRONG_TYPE_ARG (1, x); } #undef FUNC_NAME diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index d85e44c..5619bf0 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -1328,6 +1328,43 @@ (pass-if (= lcm-of-big-n-and-11 (lcm 11 big-n 11))))) ;;; +;;; rationalize +;;; +(with-test-prefix "rationalize" + (pass-if (documented? rationalize)) + (pass-if (eqv? 2 (rationalize 4 2 ))) + (pass-if (eqv? -2 (rationalize -4 2 ))) + (pass-if (eqv? 2.0 (rationalize 4 2.0))) + (pass-if (eqv? -2.0 (rationalize -4.0 2 ))) + + (pass-if (eqv? 0 (rationalize 4 8 ))) + (pass-if (eqv? 0 (rationalize -4 8 ))) + (pass-if (eqv? 0.0 (rationalize 4 8.0))) + (pass-if (eqv? 0.0 (rationalize -4.0 8 ))) + + (pass-if (eqv? 0.0 (rationalize 3 +inf.0))) + (pass-if (eqv? 0.0 (rationalize -3 +inf.0))) + + (pass-if (nan? (rationalize +inf.0 +inf.0))) + (pass-if (nan? (rationalize +nan.0 +inf.0))) + (pass-if (nan? (rationalize +nan.0 4))) + (pass-if (eqv? +inf.0 (rationalize +inf.0 3))) + + (pass-if (eqv? 3/10 (rationalize 3/10 0))) + (pass-if (eqv? -3/10 (rationalize -3/10 0))) + + (pass-if (eqv? 1/3 (rationalize 3/10 1/10))) + (pass-if (eqv? -1/3 (rationalize -3/10 1/10))) + + (pass-if (eqv? 1/3 (rationalize 3/10 -1/10))) + (pass-if (eqv? -1/3 (rationalize -3/10 -1/10))) + + (pass-if (test-eqv? (/ 1.0 3) (rationalize 0.3 1/10))) + (pass-if (test-eqv? (/ -1.0 3) (rationalize -0.3 1/10))) + (pass-if (test-eqv? (/ 1.0 3) (rationalize 0.3 -1/10))) + (pass-if (test-eqv? (/ -1.0 3) (rationalize -0.3 -1/10)))) + +;;; ;;; number->string ;;; -- 1.5.6.5 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0002-More-discriminating-NaN-predicates-for-numbers.test.patch Content-Description: More discriminating NaN predicates for numbers.test >From ab106861f0bf59f4a71535a745ae5770d4830e3d Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 1 Feb 2011 05:22:40 -0500 Subject: [PATCH] More discriminating NaN predicates for numbers.test * test-suite/tests/numbers.test: (real-nan?, complex-nan?, imaginary-nan?): Add more discriminating NaN testing predicates internal to numbers.test, and convert several uses of `nan?' to use these instead: * `real-nan?' checks that its argument is real and a NaN. * `complex-nan?' checks that both the real and imaginary parts of its argument are NaNs. * `imaginary-nan?' checks that its argument's real part is zero and the imaginary part is a NaN. --- test-suite/tests/numbers.test | 73 +++++++++++++++++++++++++---------------- 1 files changed, 45 insertions(+), 28 deletions(-) diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 5619bf0..75d3790 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -120,6 +120,23 @@ (eqv? x y)) (else (and (inexact? y) (> test-epsilon (abs (- x y))))))) +;; return true if OBJ is a real NaN +(define (real-nan? obj) + (and (real? obj) + (nan? obj))) + +;; return true if both the real and imaginary +;; parts of OBJ are NaNs +(define (complex-nan? obj) + (and (nan? (real-part obj)) + (nan? (imag-part obj)))) + +;; return true if the real part of OBJ is zero +;; and the imaginary part is a NaN. +(define (imaginary-nan? obj) + (and (zero? (real-part obj)) + (nan? (imag-part obj)))) + (define const-e 2.7182818284590452354) (define const-e^2 7.3890560989306502274) (define const-1/e 0.3678794411714423215) @@ -414,7 +431,7 @@ (pass-if (= 0.0 (abs 0.0))) (pass-if (= 1.0 (abs 1.0))) (pass-if (= 1.0 (abs -1.0))) - (pass-if (nan? (abs +nan.0))) + (pass-if (real-nan? (abs +nan.0))) (pass-if (= +inf.0 (abs +inf.0))) (pass-if (= +inf.0 (abs -inf.0)))) @@ -1345,9 +1362,9 @@ (pass-if (eqv? 0.0 (rationalize 3 +inf.0))) (pass-if (eqv? 0.0 (rationalize -3 +inf.0))) - (pass-if (nan? (rationalize +inf.0 +inf.0))) - (pass-if (nan? (rationalize +nan.0 +inf.0))) - (pass-if (nan? (rationalize +nan.0 4))) + (pass-if (real-nan? (rationalize +inf.0 +inf.0))) + (pass-if (real-nan? (rationalize +nan.0 +inf.0))) + (pass-if (real-nan? (rationalize +nan.0 4))) (pass-if (eqv? +inf.0 (rationalize +inf.0 3))) (pass-if (eqv? 3/10 (rationalize 3/10 0))) @@ -2462,10 +2479,10 @@ (pass-if (= 5/2 (max 5/2 2)))) (with-test-prefix "inum / real" - (pass-if (nan? (max 123 +nan.0)))) + (pass-if (real-nan? (max 123 +nan.0)))) (with-test-prefix "real / inum" - (pass-if (nan? (max +nan.0 123)))) + (pass-if (real-nan? (max +nan.0 123)))) (with-test-prefix "big / frac" (pass-if (= big*2 (max big*2 5/2))) @@ -2476,14 +2493,14 @@ (pass-if (= 5/2 (max 5/2 (- big*2))))) (with-test-prefix "big / real" - (pass-if (nan? (max big*5 +nan.0))) + (pass-if (real-nan? (max big*5 +nan.0))) (pass-if (eqv? (exact->inexact big*5) (max big*5 -inf.0))) (pass-if (eqv? (exact->inexact big*5) (max big*5 1.0))) (pass-if (eqv? +inf.0 (max big*5 +inf.0))) (pass-if (eqv? 1.0 (max (- big*5) 1.0)))) (with-test-prefix "real / big" - (pass-if (nan? (max +nan.0 big*5))) + (pass-if (real-nan? (max +nan.0 big*5))) (pass-if (eqv? (exact->inexact big*5) (max -inf.0 big*5))) (pass-if (eqv? (exact->inexact big*5) (max 1.0 big*5))) (pass-if (eqv? +inf.0 (max +inf.0 big*5))) @@ -2496,9 +2513,9 @@ (pass-if (= -1/2 (max -2/3 -1/2)))) (with-test-prefix "real / real" - (pass-if (nan? (max 123.0 +nan.0))) - (pass-if (nan? (max +nan.0 123.0))) - (pass-if (nan? (max +nan.0 +nan.0))) + (pass-if (real-nan? (max 123.0 +nan.0))) + (pass-if (real-nan? (max +nan.0 123.0))) + (pass-if (real-nan? (max +nan.0 +nan.0))) (pass-if (= 456.0 (max 123.0 456.0))) (pass-if (= 456.0 (max 456.0 123.0))))) @@ -2522,8 +2539,8 @@ ;; 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 (nan? (max (ash 1 2048) +nan.0))) - (pass-if (nan? (max +nan.0 (ash 1 2048))))) + (pass-if (real-nan? (max (ash 1 2048) +nan.0))) + (pass-if (real-nan? (max +nan.0 (ash 1 2048))))) ;;; ;;; min @@ -2587,10 +2604,10 @@ (pass-if (= 2 (min 5/2 2)))) (with-test-prefix "inum / real" - (pass-if (nan? (min 123 +nan.0)))) + (pass-if (real-nan? (min 123 +nan.0)))) (with-test-prefix "real / inum" - (pass-if (nan? (min +nan.0 123)))) + (pass-if (real-nan? (min +nan.0 123)))) (with-test-prefix "big / frac" (pass-if (= 5/2 (min big*2 5/2))) @@ -2601,14 +2618,14 @@ (pass-if (= (- big*2) (min 5/2 (- big*2))))) (with-test-prefix "big / real" - (pass-if (nan? (min big*5 +nan.0))) + (pass-if (real-nan? (min big*5 +nan.0))) (pass-if (eqv? (exact->inexact big*5) (min big*5 +inf.0))) (pass-if (eqv? -inf.0 (min big*5 -inf.0))) (pass-if (eqv? 1.0 (min big*5 1.0))) (pass-if (eqv? (exact->inexact (- big*5)) (min (- big*5) 1.0)))) (with-test-prefix "real / big" - (pass-if (nan? (min +nan.0 big*5))) + (pass-if (real-nan? (min +nan.0 big*5))) (pass-if (eqv? (exact->inexact big*5) (min +inf.0 big*5))) (pass-if (eqv? -inf.0 (min -inf.0 big*5))) (pass-if (eqv? 1.0 (min 1.0 big*5))) @@ -2621,9 +2638,9 @@ (pass-if (= -2/3 (min -2/3 -1/2)))) (with-test-prefix "real / real" - (pass-if (nan? (min 123.0 +nan.0))) - (pass-if (nan? (min +nan.0 123.0))) - (pass-if (nan? (min +nan.0 +nan.0))) + (pass-if (real-nan? (min 123.0 +nan.0))) + (pass-if (real-nan? (min +nan.0 123.0))) + (pass-if (real-nan? (min +nan.0 +nan.0))) (pass-if (= 123.0 (min 123.0 456.0))) (pass-if (= 123.0 (min 456.0 123.0))))) @@ -2648,8 +2665,8 @@ ;; 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 (nan? (min (- (ash 1 2048)) (- +nan.0)))) - (pass-if (nan? (min (- +nan.0) (- (ash 1 2048)))))) + (pass-if (real-nan? (min (- (ash 1 2048)) (- +nan.0)))) + (pass-if (real-nan? (min (- +nan.0) (- (ash 1 2048)))))) ;;; ;;; + @@ -3166,10 +3183,10 @@ (pass-if (eqv? 1 (expt 0.0 0))) (pass-if (eqv? 1.0 (expt 0 0.0))) (pass-if (eqv? 1.0 (expt 0.0 0.0))) - (pass-if (nan? (expt 0 -1))) - (pass-if (nan? (expt 0 -1.0))) - (pass-if (nan? (expt 0.0 -1))) - (pass-if (nan? (expt 0.0 -1.0))) + (pass-if (real-nan? (expt 0 -1))) + (pass-if (real-nan? (expt 0 -1.0))) + (pass-if (real-nan? (expt 0.0 -1))) + (pass-if (real-nan? (expt 0.0 -1.0))) (pass-if (eqv? 0 (expt 0 3))) (pass-if (= 0 (expt 0 4.0))) (pass-if (eqv? 0.0 (expt 0.0 5))) @@ -3336,8 +3353,8 @@ (pass-if (eqv? 1 (integer-expt 0 0))) (pass-if (eqv? 1 (integer-expt 0.0 0))) - (pass-if (nan? (integer-expt 0 -1))) - (pass-if (nan? (integer-expt 0.0 -1))) + (pass-if (real-nan? (integer-expt 0 -1))) + (pass-if (real-nan? (integer-expt 0.0 -1))) (pass-if (eqv? 0 (integer-expt 0 3))) (pass-if (eqv? 0.0 (integer-expt 0.0 5))) (pass-if (eqv? -2742638075.5 (integer-expt -2742638075.5 1))) -- 1.5.6.5 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0003-Handle-products-with-exact-0-differently.patch Content-Description: Handle products with exact 0 differently >From d4c1abe9bfd5397602f4d2c00ffd66a8ff133b01 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 1 Feb 2011 06:30:29 -0500 Subject: [PATCH] Handle products with exact 0 differently * libguile/numbers.c (scm_product): Handle exact 0 differently. A product containing an exact 0 now returns an exact 0 if and only if the other arguments are all exact. An inexact zero is returned if and only if the other arguments are all finite but not all exact. If an infinite or NaN value is present, a NaN value is returned. Previously, any product containing an exact 0 yielded an exact 0, regardless of the other arguments. A note on the rationale for (* 0 0.0) returning 0.0 and not exact 0: The exactness propagation rules allow us to return an exact result in the presence of inexact arguments only if the values of the inexact arguments do not affect the result. In this case, the value of the inexact argument _does_ affect the result, because an infinite or NaN value causes the result to be a NaN. A note on the rationale for (* 0 +inf.0) being a NaN and not exact 0: The R6RS requires that (/ 0 0.0) return a NaN value, and that (/ 0.0) return +inf.0. We would like (/ x y) to be the same as (* x (/ y)), and in particular, for (/ 0 0.0) to be the same as (* 0 (/ 0.0)), which reduces to (* 0 +inf.0). Therefore (* 0 +inf.0) should return a NaN. * test-suite/tests/numbers.test: Add many multiplication tests. * NEWS: Add NEWS entry. --- NEWS | 10 +++ libguile/numbers.c | 56 +++++++++++------ test-suite/tests/numbers.test | 129 +++++++++++++++++++++++++++++++++++++---- 3 files changed, 163 insertions(+), 32 deletions(-) diff --git a/NEWS b/NEWS index 3769b81..63df7db 100644 --- a/NEWS +++ b/NEWS @@ -130,6 +130,16 @@ Previously, `(equal? +nan.0 +nan.0)' returned #f, although both returned #t. R5RS requires that `equal?' behave like `eqv?' when comparing numbers. +*** Change in handling products `*' involving exact 0 + +scm_product `*' now handles exact 0 differently. A product containing +an exact 0 now returns an exact 0 if and only if the other arguments +are all exact. An inexact zero is returned if and only if the other +arguments are all finite but not all exact. If an infinite or NaN +value is present, a NaN value is returned. Previously, any product +containing an exact 0 yielded an exact 0, regardless of the other +arguments. + *** `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 diff --git a/libguile/numbers.c b/libguile/numbers.c index d4380dd..9ba340f 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -5900,22 +5900,43 @@ scm_product (SCM x, SCM y) { scm_t_inum xx; - intbig: + xinum: xx = SCM_I_INUM (x); switch (xx) { - case 0: return x; break; - case 1: return y; break; + case 1: + /* exact1 is the universal multiplicative identity */ + return y; + break; + case 0: + /* exact0 times a fixnum is exact0: optimize this case */ + if (SCM_LIKELY (SCM_I_INUMP (y))) + return SCM_INUM0; + /* if the other argument is inexact, the result is inexact, + and we must do the multiplication in order to handle + infinities and NaNs properly. */ + else if (SCM_REALP (y)) + return scm_from_double (0.0 * SCM_REAL_VALUE (y)); + else if (SCM_COMPLEXP (y)) + return scm_c_make_rectangular (0.0 * SCM_COMPLEX_REAL (y), + 0.0 * SCM_COMPLEX_IMAG (y)); + /* we've already handled inexact numbers, + so y must be exact, and we return exact0 */ + else if (SCM_NUMP (y)) + return SCM_INUM0; + else + SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); + break; + case -1: /* - * The following case (x = -1) is important for more than - * just optimization. It handles the case of negating + * This case is important for more than just optimization. + * It handles the case of negating * (+ 1 most-positive-fixnum) aka (- most-negative-fixnum), * which is a bignum that must be changed back into a fixnum. * Failure to do so will cause the following to return #f: * (= most-negative-fixnum (* -1 (- most-negative-fixnum))) */ - case -1: return scm_difference(y, SCM_UNDEFINED); break; } @@ -5957,7 +5978,7 @@ scm_product (SCM x, SCM y) if (SCM_I_INUMP (y)) { SCM_SWAP (x, y); - goto intbig; + goto xinum; } else if (SCM_BIGP (y)) { @@ -5990,12 +6011,10 @@ scm_product (SCM x, SCM y) else if (SCM_REALP (x)) { if (SCM_I_INUMP (y)) - { - /* inexact*exact0 => exact 0, per R5RS "Exactness" section */ - if (scm_is_eq (y, SCM_INUM0)) - return y; - return scm_from_double (SCM_I_INUM (y) * SCM_REAL_VALUE (x)); - } + { + SCM_SWAP (x, y); + goto xinum; + } else if (SCM_BIGP (y)) { double result = mpz_get_d (SCM_I_BIG_MPZ (y)) * SCM_REAL_VALUE (x); @@ -6015,13 +6034,10 @@ scm_product (SCM x, SCM y) else if (SCM_COMPLEXP (x)) { if (SCM_I_INUMP (y)) - { - /* inexact*exact0 => exact 0, per R5RS "Exactness" section */ - if (scm_is_eq (y, SCM_INUM0)) - return y; - return scm_c_make_rectangular (SCM_I_INUM (y) * SCM_COMPLEX_REAL (x), - SCM_I_INUM (y) * SCM_COMPLEX_IMAG (x)); - } + { + SCM_SWAP (x, y); + goto xinum; + } else if (SCM_BIGP (y)) { double z = mpz_get_d (SCM_I_BIG_MPZ (y)); diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 75d3790..96fb6d9 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -2745,6 +2745,115 @@ (pass-if (eqv? fixnum-min (* (* fixnum-min -1) -1))) (pass-if (equal? fixnum-min (* (* fixnum-min -1) -1)))) + (with-test-prefix "exactness propagation" + (pass-if (eqv? -0.0 (* 0 -1.0 ))) + (pass-if (eqv? 0.0 (* 0 1.0 ))) + (pass-if (eqv? -0.0 (* -1.0 0 ))) + (pass-if (eqv? 0.0 (* 1.0 0 ))) + (pass-if (eqv? 0 (* 0 1/2 ))) + (pass-if (eqv? 0 (* 1/2 0 ))) + (pass-if (eqv? 0.0+0.0i (* 0 1+i ))) + (pass-if (eqv? 0.0+0.0i (* 1+i 0 ))) + (pass-if (eqv? -1.0 (* 1 -1.0 ))) + (pass-if (eqv? 1.0 (* 1 1.0 ))) + (pass-if (eqv? -1.0 (* -1.0 1 ))) + (pass-if (eqv? 1.0 (* 1.0 1 ))) + (pass-if (eqv? 1/2 (* 1 1/2 ))) + (pass-if (eqv? 1/2 (* 1/2 1 ))) + (pass-if (eqv? 1+i (* 1 1+i ))) + (pass-if (eqv? 1+i (* 1+i 1 )))) + + (with-test-prefix "propagation of NaNs" + (pass-if (real-nan? (* +nan.0 +nan.0))) + (pass-if (real-nan? (* +nan.0 1 ))) + (pass-if (real-nan? (* +nan.0 -1 ))) + (pass-if (real-nan? (* +nan.0 -7/2 ))) + (pass-if (real-nan? (* +nan.0 1e20 ))) + (pass-if (real-nan? (* 1 +nan.0))) + (pass-if (real-nan? (* -1 +nan.0))) + (pass-if (real-nan? (* -7/2 +nan.0))) + (pass-if (real-nan? (* 1e20 +nan.0))) + (pass-if (real-nan? (* +inf.0 +nan.0))) + (pass-if (real-nan? (* +nan.0 +inf.0))) + (pass-if (real-nan? (* -inf.0 +nan.0))) + (pass-if (real-nan? (* +nan.0 -inf.0))) + (pass-if (real-nan? (* (* fixnum-max 2) +nan.0))) + (pass-if (real-nan? (* +nan.0 (* fixnum-max 2)))) + + (pass-if (real-nan? (* 0 +nan.0 ))) + (pass-if (real-nan? (* +nan.0 0 ))) + (pass-if (real-nan? (* 0 +nan.0+i))) + (pass-if (real-nan? (* +nan.0+i 0 ))) + + (pass-if (imaginary-nan? (* 0 +nan.0i ))) + (pass-if (imaginary-nan? (* +nan.0i 0 ))) + (pass-if (imaginary-nan? (* 0 1+nan.0i ))) + (pass-if (imaginary-nan? (* 1+nan.0i 0 ))) + + (pass-if (complex-nan? (* 0 +nan.0+nan.0i ))) + (pass-if (complex-nan? (* +nan.0+nan.0i 0 )))) + + (with-test-prefix "infinities" + (pass-if (eqv? +inf.0 (* +inf.0 5 ))) + (pass-if (eqv? -inf.0 (* +inf.0 -5 ))) + (pass-if (eqv? +inf.0 (* +inf.0 73.1))) + (pass-if (eqv? -inf.0 (* +inf.0 -9.2))) + (pass-if (eqv? +inf.0 (* +inf.0 5/2))) + (pass-if (eqv? -inf.0 (* +inf.0 -5/2))) + (pass-if (eqv? -inf.0 (* -5 +inf.0))) + (pass-if (eqv? +inf.0 (* 73.1 +inf.0))) + (pass-if (eqv? -inf.0 (* -9.2 +inf.0))) + (pass-if (eqv? +inf.0 (* 5/2 +inf.0))) + (pass-if (eqv? -inf.0 (* -5/2 +inf.0))) + + (pass-if (eqv? -inf.0 (* -inf.0 5 ))) + (pass-if (eqv? +inf.0 (* -inf.0 -5 ))) + (pass-if (eqv? -inf.0 (* -inf.0 73.1))) + (pass-if (eqv? +inf.0 (* -inf.0 -9.2))) + (pass-if (eqv? -inf.0 (* -inf.0 5/2))) + (pass-if (eqv? +inf.0 (* -inf.0 -5/2))) + (pass-if (eqv? +inf.0 (* -5 -inf.0))) + (pass-if (eqv? -inf.0 (* 73.1 -inf.0))) + (pass-if (eqv? +inf.0 (* -9.2 -inf.0))) + (pass-if (eqv? -inf.0 (* 5/2 -inf.0))) + (pass-if (eqv? +inf.0 (* -5/2 -inf.0))) + + (pass-if (real-nan? (* 0.0 +inf.0))) + (pass-if (real-nan? (* -0.0 +inf.0))) + (pass-if (real-nan? (* +inf.0 0.0))) + (pass-if (real-nan? (* +inf.0 -0.0))) + + (pass-if (real-nan? (* 0.0 -inf.0))) + (pass-if (real-nan? (* -0.0 -inf.0))) + (pass-if (real-nan? (* -inf.0 0.0))) + (pass-if (real-nan? (* -inf.0 -0.0))) + + (pass-if (real-nan? (* 0 +inf.0 ))) + (pass-if (real-nan? (* +inf.0 0 ))) + (pass-if (real-nan? (* 0 +inf.0+i))) + (pass-if (real-nan? (* +inf.0+i 0 ))) + + (pass-if (real-nan? (* 0 -inf.0 ))) + (pass-if (real-nan? (* -inf.0 0 ))) + (pass-if (real-nan? (* 0 -inf.0+i))) + (pass-if (real-nan? (* -inf.0+i 0 ))) + + (pass-if (imaginary-nan? (* 0 +inf.0i ))) + (pass-if (imaginary-nan? (* +inf.0i 0 ))) + (pass-if (imaginary-nan? (* 0 1+inf.0i ))) + (pass-if (imaginary-nan? (* 1+inf.0i 0 ))) + + (pass-if (imaginary-nan? (* 0 -inf.0i ))) + (pass-if (imaginary-nan? (* -inf.0i 0 ))) + (pass-if (imaginary-nan? (* 0 1-inf.0i ))) + (pass-if (imaginary-nan? (* 1-inf.0i 0 ))) + + (pass-if (complex-nan? (* 0 +inf.0+inf.0i ))) + (pass-if (complex-nan? (* +inf.0+inf.0i 0 ))) + + (pass-if (complex-nan? (* 0 +inf.0-inf.0i ))) + (pass-if (complex-nan? (* -inf.0+inf.0i 0 )))) + (with-test-prefix "inum * bignum" (pass-if "0 * 2^256 = 0" @@ -2752,13 +2861,13 @@ (with-test-prefix "inum * flonum" - (pass-if "0 * 1.0 = 0" - (eqv? 0 (* 0 1.0)))) + (pass-if "0 * 1.0 = 0.0" + (eqv? 0.0 (* 0 1.0)))) (with-test-prefix "inum * complex" - (pass-if "0 * 1+1i = 0" - (eqv? 0 (* 0 1+1i)))) + (pass-if "0 * 1+1i = 0.0+0.0i" + (eqv? 0.0+0.0i (* 0 1+1i)))) (with-test-prefix "inum * frac" @@ -2771,16 +2880,12 @@ (eqv? 0 (* (ash 1 256) 0)))) (with-test-prefix "flonum * inum" - - ;; in guile 1.6.8 and 1.8.1 and earlier this returned inexact 0.0 - (pass-if "1.0 * 0 = 0" - (eqv? 0 (* 1.0 0)))) + (pass-if "1.0 * 0 = 0.0" + (eqv? 0.0 (* 1.0 0)))) (with-test-prefix "complex * inum" - - ;; in guile 1.6.8 and 1.8.1 and earlier this returned inexact 0.0 - (pass-if "1+1i * 0 = 0" - (eqv? 0 (* 1+1i 0)))) + (pass-if "1+1i * 0 = 0.0+0.0i" + (eqv? 0.0+0.0i (* 1+1i 0)))) (pass-if "complex * bignum" (let ((big (ash 1 90))) -- 1.5.6.5 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0004-Move-comment-about-trig-functions-back-where-it-belo.patch Content-Description: Move comment about trig functions back where it belongs >From c7d7dec54e0c6ff75d3a98cc2e5f4e750e9c5e62 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 1 Feb 2011 06:50:48 -0500 Subject: [PATCH] Move comment about trig functions back where it belongs * libguile/numbers.c: Move a comment about the trigonometric functions next to those functions. At some point they became separated, when scm_expt was placed between them. --- libguile/numbers.c | 12 ++++++------ 1 files changed, 6 insertions(+), 6 deletions(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index 9ba340f..f9e00e6 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -6692,12 +6692,6 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling, "ceiling", 1, 0, 0, } #undef FUNC_NAME -/* sin/cos/tan/asin/acos/atan - sinh/cosh/tanh/asinh/acosh/atanh - Derived from "Transcen.scm", Complex trancendental functions for SCM. - Written by Jerry D. Hedden, (C) FSF. - See the file `COPYING' for terms applying to this program. */ - SCM_PRIMITIVE_GENERIC (scm_expt, "expt", 2, 0, 0, (SCM x, SCM y), "Return @var{x} raised to the power of @var{y}.") @@ -6739,6 +6733,12 @@ SCM_PRIMITIVE_GENERIC (scm_expt, "expt", 2, 0, 0, } #undef FUNC_NAME +/* sin/cos/tan/asin/acos/atan + sinh/cosh/tanh/asinh/acosh/atanh + Derived from "Transcen.scm", Complex trancendental functions for SCM. + Written by Jerry D. Hedden, (C) FSF. + See the file `COPYING' for terms applying to this program. */ + SCM_PRIMITIVE_GENERIC (scm_sin, "sin", 1, 0, 0, (SCM z), "Compute the sine of @var{z}.") -- 1.5.6.5 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0005-Trigonometric-functions-return-exact-numbers-in-some.patch Content-Description: Trigonometric functions return exact numbers in some cases >From 702c1210e420a0fcd68b9c62f85633c5401a3a28 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 1 Feb 2011 06:56:02 -0500 Subject: [PATCH] Trigonometric functions return exact numbers in some cases * libguile/numbers.c (scm_sin, scm_cos, scm_tan, scm_asin, scm_acos, scm_atan, scm_sinh, scm_cosh, scm_tanh, scm_sys_asinh, scm_sys_acosh, scm_sys_atanh): Return an exact result in some cases. * test-suite/tests/numbers.test: Add test cases. * NEWS: Add NEWS entry --- NEWS | 7 +++ libguile/numbers.c | 48 ++++++++++++++----- test-suite/tests/numbers.test | 102 +++++++++++++++++++++++++++++++++++++++- 3 files changed, 142 insertions(+), 15 deletions(-) diff --git a/NEWS b/NEWS index 63df7db..64d2864 100644 --- a/NEWS +++ b/NEWS @@ -187,6 +187,13 @@ was at least 1 or inexact, e.g. (rationalize 4 1) should return 3 per R5RS and R6RS, but previously it returned 4. It also now handles cases involving infinities and NaNs properly, per R6RS. +*** Trigonometric functions now return exact numbers in some cases + +scm_sin `sin', scm_cos `cos', scm_tan `tan', scm_asin `asin', scm_acos +`acos', scm_atan `atan', scm_sinh `sinh', scm_cosh `cosh', scm_tanh +`tanh', scm_sys_asinh `asinh', scm_sys_acosh `acosh', and +scm_sys_atanh `atanh' now return exact results in some cases. + *** New procedure: `finite?' Add scm_finite_p `finite?' from R6RS to guile core, which returns #t diff --git a/libguile/numbers.c b/libguile/numbers.c index f9e00e6..df95c32 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -6744,7 +6744,9 @@ SCM_PRIMITIVE_GENERIC (scm_sin, "sin", 1, 0, 0, "Compute the sine of @var{z}.") #define FUNC_NAME s_scm_sin { - if (scm_is_real (z)) + if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0))) + return z; /* sin(exact0) = exact0 */ + else if (scm_is_real (z)) return scm_from_double (sin (scm_to_double (z))); else if (SCM_COMPLEXP (z)) { double x, y; @@ -6763,7 +6765,9 @@ SCM_PRIMITIVE_GENERIC (scm_cos, "cos", 1, 0, 0, "Compute the cosine of @var{z}.") #define FUNC_NAME s_scm_cos { - if (scm_is_real (z)) + if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0))) + return SCM_INUM1; /* cos(exact0) = exact1 */ + else if (scm_is_real (z)) return scm_from_double (cos (scm_to_double (z))); else if (SCM_COMPLEXP (z)) { double x, y; @@ -6782,7 +6786,9 @@ SCM_PRIMITIVE_GENERIC (scm_tan, "tan", 1, 0, 0, "Compute the tangent of @var{z}.") #define FUNC_NAME s_scm_tan { - if (scm_is_real (z)) + if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0))) + return z; /* tan(exact0) = exact0 */ + else if (scm_is_real (z)) return scm_from_double (tan (scm_to_double (z))); else if (SCM_COMPLEXP (z)) { double x, y, w; @@ -6805,7 +6811,9 @@ SCM_PRIMITIVE_GENERIC (scm_sinh, "sinh", 1, 0, 0, "Compute the hyperbolic sine of @var{z}.") #define FUNC_NAME s_scm_sinh { - if (scm_is_real (z)) + if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0))) + return z; /* sinh(exact0) = exact0 */ + else if (scm_is_real (z)) return scm_from_double (sinh (scm_to_double (z))); else if (SCM_COMPLEXP (z)) { double x, y; @@ -6824,7 +6832,9 @@ SCM_PRIMITIVE_GENERIC (scm_cosh, "cosh", 1, 0, 0, "Compute the hyperbolic cosine of @var{z}.") #define FUNC_NAME s_scm_cosh { - if (scm_is_real (z)) + if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0))) + return SCM_INUM1; /* cosh(exact0) = exact1 */ + else if (scm_is_real (z)) return scm_from_double (cosh (scm_to_double (z))); else if (SCM_COMPLEXP (z)) { double x, y; @@ -6843,7 +6853,9 @@ SCM_PRIMITIVE_GENERIC (scm_tanh, "tanh", 1, 0, 0, "Compute the hyperbolic tangent of @var{z}.") #define FUNC_NAME s_scm_tanh { - if (scm_is_real (z)) + if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0))) + return z; /* tanh(exact0) = exact0 */ + else if (scm_is_real (z)) return scm_from_double (tanh (scm_to_double (z))); else if (SCM_COMPLEXP (z)) { double x, y, w; @@ -6866,7 +6878,9 @@ SCM_PRIMITIVE_GENERIC (scm_asin, "asin", 1, 0, 0, "Compute the arc sine of @var{z}.") #define FUNC_NAME s_scm_asin { - if (scm_is_real (z)) + if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0))) + return z; /* asin(exact0) = exact0 */ + else if (scm_is_real (z)) { double w = scm_to_double (z); if (w >= -1.0 && w <= 1.0) @@ -6892,7 +6906,9 @@ SCM_PRIMITIVE_GENERIC (scm_acos, "acos", 1, 0, 0, "Compute the arc cosine of @var{z}.") #define FUNC_NAME s_scm_acos { - if (scm_is_real (z)) + if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM1))) + return SCM_INUM0; /* acos(exact1) = exact0 */ + else if (scm_is_real (z)) { double w = scm_to_double (z); if (w >= -1.0 && w <= 1.0) @@ -6924,7 +6940,9 @@ SCM_PRIMITIVE_GENERIC (scm_atan, "atan", 1, 1, 0, { if (SCM_UNBNDP (y)) { - if (scm_is_real (z)) + if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0))) + return z; /* atan(exact0) = exact0 */ + else if (scm_is_real (z)) return scm_from_double (atan (scm_to_double (z))); else if (SCM_COMPLEXP (z)) { @@ -6955,7 +6973,9 @@ SCM_PRIMITIVE_GENERIC (scm_sys_asinh, "asinh", 1, 0, 0, "Compute the inverse hyperbolic sine of @var{z}.") #define FUNC_NAME s_scm_sys_asinh { - if (scm_is_real (z)) + if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0))) + return z; /* asinh(exact0) = exact0 */ + else if (scm_is_real (z)) return scm_from_double (asinh (scm_to_double (z))); else if (scm_is_number (z)) return scm_log (scm_sum (z, @@ -6971,7 +6991,9 @@ SCM_PRIMITIVE_GENERIC (scm_sys_acosh, "acosh", 1, 0, 0, "Compute the inverse hyperbolic cosine of @var{z}.") #define FUNC_NAME s_scm_sys_acosh { - if (scm_is_real (z) && scm_to_double (z) >= 1.0) + if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM1))) + return SCM_INUM0; /* acosh(exact1) = exact0 */ + else if (scm_is_real (z) && scm_to_double (z) >= 1.0) return scm_from_double (acosh (scm_to_double (z))); else if (scm_is_number (z)) return scm_log (scm_sum (z, @@ -6987,7 +7009,9 @@ SCM_PRIMITIVE_GENERIC (scm_sys_atanh, "atanh", 1, 0, 0, "Compute the inverse hyperbolic tangent of @var{z}.") #define FUNC_NAME s_scm_sys_atanh { - if (scm_is_real (z) && scm_to_double (z) >= -1.0 && scm_to_double (z) <= 1.0) + if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0))) + return z; /* atanh(exact0) = exact0 */ + else if (scm_is_real (z) && scm_to_double (z) >= -1.0 && scm_to_double (z) <= 1.0) return scm_from_double (atanh (scm_to_double (z))); else if (scm_is_number (z)) return scm_divide (scm_log (scm_divide (scm_sum (SCM_INUM1, z), diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 96fb6d9..9c01fa1 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -3316,25 +3316,121 @@ ;;; +;;; sin +;;; + +(with-test-prefix "sin" + (pass-if (eqv? 0 (sin 0))) + (pass-if (eqv? 0.0 (sin 0.0))) + (pass-if (eqv-loosely? 1.0 (sin 1.57))) + (pass-if (eqv-loosely? +1.175i (sin +i))) + (pass-if (real-nan? (sin +nan.0))) + (pass-if (real-nan? (sin +inf.0))) + (pass-if (real-nan? (sin -inf.0)))) + +;;; +;;; cos +;;; + +(with-test-prefix "cos" + (pass-if (eqv? 1 (cos 0))) + (pass-if (eqv? 1.0 (cos 0.0))) + (pass-if (eqv-loosely? 0.0 (cos 1.57))) + (pass-if (eqv-loosely? 1.543 (cos +i))) + (pass-if (real-nan? (cos +nan.0))) + (pass-if (real-nan? (cos +inf.0))) + (pass-if (real-nan? (cos -inf.0)))) + +;;; +;;; tan +;;; + +(with-test-prefix "tan" + (pass-if (eqv? 0 (tan 0))) + (pass-if (eqv? 0.0 (tan 0.0))) + (pass-if (eqv-loosely? 1.0 (tan 0.785))) + (pass-if (eqv-loosely? +0.76i (tan +i))) + (pass-if (real-nan? (tan +nan.0))) + (pass-if (real-nan? (tan +inf.0))) + (pass-if (real-nan? (tan -inf.0)))) + +;;; +;;; asin +;;; + +(with-test-prefix "asin" + (pass-if (complex-nan? (asin +nan.0))) + (pass-if (eqv? 0 (asin 0))) + (pass-if (eqv? 0.0 (asin 0.0)))) + +;;; +;;; acos +;;; + +(with-test-prefix "acos" + (pass-if (complex-nan? (acos +nan.0))) + (pass-if (eqv? 0 (acos 1))) + (pass-if (eqv? 0.0 (acos 1.0)))) + +;;; +;;; atan +;;; +;;; FIXME: add tests for two-argument atan +;;; +(with-test-prefix "atan" + (pass-if (real-nan? (atan +nan.0))) + (pass-if (eqv? 0 (atan 0))) + (pass-if (eqv? 0.0 (atan 0.0))) + (pass-if (eqv-loosely? 1.57 (atan +inf.0))) + (pass-if (eqv-loosely? -1.57 (atan -inf.0)))) + +;;; +;;; sinh +;;; + +(with-test-prefix "sinh" + (pass-if (= 0 (sinh 0))) + (pass-if (= 0.0 (sinh 0.0)))) + +;;; +;;; cosh +;;; + +(with-test-prefix "cosh" + (pass-if (= 1 (cosh 0))) + (pass-if (= 1.0 (cosh 0.0)))) + +;;; +;;; tanh +;;; + +(with-test-prefix "tanh" + (pass-if (= 0 (tanh 0))) + (pass-if (= 0.0 (tanh 0.0)))) + +;;; ;;; asinh ;;; (with-test-prefix "asinh" - (pass-if (= 0 (asinh 0)))) + (pass-if (= 0 (asinh 0))) + (pass-if (= 0.0 (asinh 0.0)))) ;;; ;;; acosh ;;; (with-test-prefix "acosh" - (pass-if (= 0 (acosh 1)))) + (pass-if (= 0 (acosh 1))) + (pass-if (= 0.0 (acosh 1.0)))) ;;; ;;; atanh ;;; (with-test-prefix "atanh" - (pass-if (= 0 (atanh 0)))) + (pass-if (= 0 (atanh 0))) + (pass-if (= 0.0 (atanh 0.0)))) ;;; ;;; make-rectangular -- 1.5.6.5 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0006-Improve-discussion-of-exactness-propagation-in-manua.patch Content-Description: Improve discussion of exactness propagation in manual >From c00d87d077720a895ef8f52732760549e15c3b6d Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Thu, 27 Jan 2011 15:57:38 -0500 Subject: [PATCH] Improve discussion of exactness propagation in manual * doc/ref/api-data.texi (Exact and Inexact Numbers): Improve the discussion of exactness propagation. Mention that there are exceptions to the rule that calculations involving inexact numbers must product an inexact result. --- doc/ref/api-data.texi | 13 +++++++++---- 1 files changed, 9 insertions(+), 4 deletions(-) diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index b819fcb..1ce9e1e 100755 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -712,14 +712,19 @@ Equivalent to @code{scm_is_true (scm_complex_p (val))}. @rnindex exact->inexact @rnindex inexact->exact -R5RS requires that a calculation involving inexact numbers always -produces an inexact result. To meet this requirement, Guile -distinguishes between an exact integer value such as @samp{5} and the -corresponding inexact real value which, to the limited precision +R5RS requires that, with few exceptions, a calculation involving inexact +numbers always produces an inexact result. To meet this requirement, +Guile distinguishes between an exact integer value such as @samp{5} and +the corresponding inexact integer value which, to the limited precision available, has no fractional part, and is printed as @samp{5.0}. Guile will only convert the latter value to the former when forced to do so by an invocation of the @code{inexact->exact} procedure. +The only exception to the above requirement is when the values of the +inexact numbers do not affect the result. For example @code{(expt n 0)} +is @samp{1} for any value of @code{n}, therefore @code{(expt 5.0 0)} is +permitted to return an exact @samp{1}. + @deffn {Scheme Procedure} exact? z @deffnx {C Function} scm_exact_p (z) Return @code{#t} if the number @var{z} is exact, @code{#f} -- 1.5.6.5 --=-=-=--