[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-14-162-g6
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-14-162-g654b282 |
|
Date: |
Tue, 01 Feb 2011 20:36:34 +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=654b2823be228af60cd371216fa0f89231542947
The branch, master has been updated
via 654b2823be228af60cd371216fa0f89231542947 (commit)
via 7f41099e9964b207560d48593a6838ba47a2f209 (commit)
via 5e7918077a4015768a352ab19e4a8e94531bc8aa (commit)
via 55a8b70819100b1341046ab5254f7858bcd74386 (commit)
via 605f698026db9e4e8af4454bc1ae09f6e97b4218 (commit)
via 820381bc7fd7d6ff4efe070853190d4b48bc5fc0 (commit)
via 644350c8b1ffc1dd305a725413f44abf0610975b (commit)
from 2d7908db7eecc13999d90200e7b8e511138cb4db (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 654b2823be228af60cd371216fa0f89231542947
Author: Mark H Weaver <address@hidden>
Date: Thu Jan 27 15:57:38 2011 -0500
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.
commit 7f41099e9964b207560d48593a6838ba47a2f209
Author: Mark H Weaver <address@hidden>
Date: Tue Feb 1 06:50:48 2011 -0500
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.
commit 5e7918077a4015768a352ab19e4a8e94531bc8aa
Author: Mark H Weaver <address@hidden>
Date: Tue Feb 1 06:30:29 2011 -0500
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.
commit 55a8b70819100b1341046ab5254f7858bcd74386
Author: Mark H Weaver <address@hidden>
Date: Tue Feb 1 05:22:40 2011 -0500
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.
commit 605f698026db9e4e8af4454bc1ae09f6e97b4218
Author: Mark H Weaver <address@hidden>
Date: Tue Feb 1 05:19:24 2011 -0500
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
commit 820381bc7fd7d6ff4efe070853190d4b48bc5fc0
Author: Mark H Weaver <address@hidden>
Date: Tue Feb 1 04:40:33 2011 -0500
Fix and combine NEWS entries on `infinite?' and `finite?'
* NEWS: Fix and combine NEWS entries on `infinite?' and `finite?'.
Previous, they stated that these predicates now work on non-real
complex numbers, but that is not the case.
commit 644350c8b1ffc1dd305a725413f44abf0610975b
Author: Mark H Weaver <address@hidden>
Date: Tue Feb 1 04:31:13 2011 -0500
Update copyright date of manual, and a small fix
* doc/ref/guile.texi: Update copyright date to 2011.
* doc/ref/r6rs.texi (rnrs base): Fix typo: `rem0' -> `div0'.
-----------------------------------------------------------------------
Summary of changes:
NEWS | 29 ++++--
doc/ref/api-data.texi | 13 ++-
doc/ref/guile.texi | 4 +-
doc/ref/r6rs.texi | 2 +-
libguile/numbers.c | 120 ++++++++++++++-------
test-suite/tests/numbers.test | 233 ++++++++++++++++++++++++++++++++++-------
6 files changed, 310 insertions(+), 91 deletions(-)
diff --git a/NEWS b/NEWS
index 3770cde..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
@@ -169,6 +179,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
@@ -186,15 +204,8 @@ remainder operators' for more information.
**** `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).
+`infinite?' and `finite?' now throw exceptions for non-numbers. (Note
+that NaNs _are_ considered numbers by scheme, despite their name).
**** `real-valued?', `rational-valued?' and `integer-valued?' changes
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}
diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
index 1e7a277..dfadd13 100644
--- a/doc/ref/guile.texi
+++ b/doc/ref/guile.texi
@@ -12,8 +12,8 @@
@copying
This manual documents Guile version @value{VERSION}.
-Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2009, 2010 Free
-Software Foundation.
+Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2009,
+2010, 2011 Free Software Foundation.
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
diff --git a/doc/ref/r6rs.texi b/doc/ref/r6rs.texi
index d6d9d9f..ffd238d 100644
--- a/doc/ref/r6rs.texi
+++ b/doc/ref/r6rs.texi
@@ -499,7 +499,7 @@ it returns @math{ceiling(@var{x}/@var{y})}.
@deffnx {Scheme Procedure} div0-and-mod0 x y
These procedures accept two real numbers @var{x} and @var{y}, where the
divisor @var{y} must be non-zero. @code{div0} returns the
-integer @var{q} and @code{rem0} returns the real number
+integer @var{q} and @code{mod0} returns the real number
@var{r} such that @address@hidden = @address@hidden + @var{r}} and
@math{-abs(@var{y}/2) <= @var{r} < abs(@var{y}/2)}. @code{div0-and-mod0}
returns both @var{q} and @var{r}, and is more efficient than computing
diff --git a/libguile/numbers.c b/libguile/numbers.c
index d08d15f..f9e00e6 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));
@@ -6676,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}.")
@@ -6723,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}.")
@@ -7267,11 +7283,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 +7336,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 +7344,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 +7354,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 +7369,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..96fb6d9 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))))
@@ -1328,6 +1345,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 (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)))
+ (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
;;;
@@ -2425,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)))
@@ -2439,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)))
@@ -2459,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)))))
@@ -2485,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
@@ -2550,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)))
@@ -2564,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)))
@@ -2584,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)))))
@@ -2611,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))))))
;;;
;;; +
@@ -2691,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"
@@ -2698,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"
@@ -2717,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)))
@@ -3129,10 +3288,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)))
@@ -3299,8 +3458,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)))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-14-162-g654b282,
Andy Wingo <=