>From ebe58755fab58390e508a1ac3e0ceaa66ab354b6 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 2 Feb 2011 05:29:55 -0500 Subject: [PATCH] Support non-real complex numbers with inexact zero imaginary part Add the ability to represent non-real complex numbers whose imaginary part is an _inexact_ zero (0.0 or -0.0), per R6RS. Previously, such numbers were immediately changed into inexact reals. * libguile/numbers.c: Remove from the list of `General assumptions' in numbers.c that objects satisfying SCM_COMPLEXP() have a non-zero complex component. This is no longer true. Also add a warning about another unrelated assumption that is not entirely correct (that floor(r) == r implies that mpz_set_d will DTRT; it won't if r is infinite). (icmplx2str): Always print the imaginary part, even if it is zero. Also handle a negative zero imaginary part more gracefully. It now prints 0.0-0.0i, where previously it would print 0.0+-0.0i. (mem2ureal): Replace scm_from_double (0.0) with flo0. (scm_c_make_rectangular): Always create non-real complex numbers. Previously it would create inexact reals if the specified imaginary part was zero. (scm_make_rectangular): If the imaginary part is an _exact_ 0, return the real part unchanged (possibly exact), otherwise return a non-real complex number (possibly with an inexact zero imaginary part). Previously, it would return an inexact real number whenever the imaginary part was any kind of zero. (scm_make_polar): If the magnitude is an exact 0, return an exact 0. If the angle is an exact 0, return the magnitude unchanged (possibly exact). Otherwise return a non-real complex number (possibly with an inexact zero imaginary part). Previously, it would return a real number whenever the imaginary part was any kind of zero. (scm_imag_part): Return an exact 0 if applied to a real number. Previously it would return an inexact zero if applied to an inexact real number. (scm_inexact_to_exact): Accept complex numbers with inexact zero imaginary part. In that case, simply use the real part and ignore the imaginary part. Essentially we coerce the inexact zero imaginary part to an exact 0. * test-suite/tests/numbers.test: Add many test cases, and modify existing tests as needed to reflect these changes. Also add a new internal predicate: `almost-real-nan?' which tests for a non-real complex number with zero imaginary part whose real part is a NaN. * doc/ref/api-data.texi (Complex Numbers): Update description of complex numbers to reflect these changes: non-real complex numbers in Guile need not have non-zero imaginary part. Also, each part of a complex number may be any inexact real, not just rationals as was previously stated. Explicitly mention that each part may be an infinity, a NaN, or a signed zero. (Complex Number Operations): Change the formal parameter names of `make-polar' from `x' and `y' to `mag' and `ang'. * NEWS: Add news entries. --- NEWS | 42 +++++++++ doc/ref/api-data.texi | 20 +++-- libguile/numbers.c | 98 ++++++++++++--------- test-suite/tests/numbers.test | 187 ++++++++++++++++++++++++++++++++++++----- 4 files changed, 274 insertions(+), 73 deletions(-) diff --git a/NEWS b/NEWS index 64d2864..2d3afdc 100644 --- a/NEWS +++ b/NEWS @@ -115,6 +115,48 @@ Note that these operators are equivalent to the R6RS integer division operators `div', `mod', `div-and-mod', `div0', `mod0', and `div0-and-mod0'. +*** Complex number changes + +Guile is now able to represent non-real complex numbers whose +imaginary part is an _inexact_ zero (0.0 or -0.0), per R6RS. +Previously, such numbers were immediately changed into inexact reals. + +(real? 0.0+0.0i) now returns #f, per R6RS, although (zero? 0.0+0.0i) +still returns #t, per R6RS. (= 0 0.0+0.0i) and (= 0.0 0.0+0.0i) are +#t, but the same comparisons using `eqv?' or `equal?' are #f. + +Like other non-real numbers, these complex numbers with inexact zero +imaginary part will raise exceptions is passed to procedures requiring +reals, such as `<', `>', `<=', `>=', `min', `max', `positive?', +`negative?', `inf?', `nan?', `finite?', etc. + +**** `make-rectangular' changes + +scm_make_rectangular `make-rectangular' now returns a real number only +if the imaginary part is an _exact_ 0. Previously, it would return a +real number if the imaginary part was an inexact zero. + +scm_c_make_rectangular now always returns a non-real complex number, +even if the imaginary part is zero. Previously, it would return a +real number if the imaginary part was zero. + +**** `make-polar' changes + +scm_make_polar `make-polar' now returns a real number only if the +angle or magnitude is an _exact_ 0. If the magnitude is an exact 0, +it now returns an exact 0. Previously, it would return a real +number if the imaginary part was an inexact zero. + +scm_c_make_polar now always returns a non-real complex number, even if +the imaginary part is 0.0. Previously, it would return a real number +if the imaginary part was 0.0. + +**** `imag-part' changes + +scm_imag_part `imag-part' now returns an exact 0 if applied to an +inexact real number. Previously it returned an inexact zero in this +case. + *** `eqv?' and `equal?' now compare numbers equivalently scm_equal_p `equal?' now behaves equivalently to scm_eqv_p `eqv?' for diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 1ce9e1e..9b065a5 100755 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -683,11 +683,15 @@ angle, -1@@1.57079 @result{} 0.0-1.0i (approx) @end lisp -Guile represents a complex number with a non-zero imaginary part as a -pair of inexact rationals, so the real and imaginary parts of a -complex number have the same properties of inexactness and limited -precision as single inexact rational numbers. Guile can not represent -exact complex numbers with non-zero imaginary parts. +Guile represents a complex number as a pair of inexact reals, so the +real and imaginary parts of a complex number have the same properties of +inexactness and limited precision as single inexact real numbers. + +Note that each part of a complex number may contain any inexact real +value, including the special values @samp{+nan.0}, @samp{+inf.0} and address@hidden, as well as either of the signed zeroes @samp{0.0} or address@hidden + @deffn {Scheme Procedure} complex? z @deffnx {C Function} scm_complex_p (z) @@ -1077,10 +1081,10 @@ locale-dependent parsing). Return a complex number constructed of the given @var{real-part} and @var{imaginary-part} parts. @end deffn address@hidden {Scheme Procedure} make-polar x y address@hidden {C Function} scm_make_polar (x, y) address@hidden {Scheme Procedure} make-polar mag ang address@hidden {C Function} scm_make_polar (mag, ang) @cindex polar form -Return the complex number @var{x} * e^(i * @var{y}). +Return the complex number @var{mag} * e^(i * @var{ang}). @end deffn @c begin (texi-doc-string "guile" "real-part") diff --git a/libguile/numbers.c b/libguile/numbers.c index 9a7848a..18d5755 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -22,10 +22,10 @@ /* General assumptions: - * All objects satisfying SCM_COMPLEXP() have a non-zero complex component. * All objects satisfying SCM_BIGP() are too large to fit in a fixnum. * If an object satisfies integer?, it's either an inum, a bignum, or a real. * If floor (r) == r, r is an int, and mpz_set_d will DTRT. + * XXX What about infinities? They are equal to their own floor! -mhw * All objects satisfying SCM_FRACTIONP are never an integer. */ @@ -3649,17 +3649,20 @@ static size_t icmplx2str (double real, double imag, char *str, int radix) { size_t i; + double sgn; i = idbl2str (real, str, radix); - if (imag != 0.0) - { - /* Don't output a '+' for negative numbers or for Inf and - NaN. They will provide their own sign. */ - if (0 <= imag && !isinf (imag) && !isnan (imag)) - str[i++] = '+'; - i += idbl2str (imag, &str[i], radix); - str[i++] = 'i'; - } +#ifdef HAVE_COPYSIGN + sgn = copysign (1.0, imag); +#else + sgn = imag; +#endif + /* Don't output a '+' for negative numbers or for Inf and + NaN. They will provide their own sign. */ + if (sgn >= 0 && DOUBLE_IS_FINITE (imag)) + str[i++] = '+'; + i += idbl2str (imag, &str[i], radix); + str[i++] = 'i'; return i; } @@ -4206,7 +4209,7 @@ mem2ureal (SCM mem, unsigned int *p_idx, floating point value so that we can change its sign. */ if (scm_is_eq (result, SCM_INUM0) && *p_exactness == INEXACT) - result = scm_from_double (0.0); + result = flo0; return result; } @@ -7107,19 +7110,14 @@ SCM_PRIMITIVE_GENERIC (scm_sys_atanh, "atanh", 1, 0, 0, SCM scm_c_make_rectangular (double re, double im) { - if (im == 0.0) - return scm_from_double (re); - else - { - SCM z; + SCM z; - z = PTR2SCM (scm_gc_malloc_pointerless (sizeof (scm_t_complex), - "complex")); - SCM_SET_CELL_TYPE (z, scm_tc16_complex); - SCM_COMPLEX_REAL (z) = re; - SCM_COMPLEX_IMAG (z) = im; - return z; - } + z = PTR2SCM (scm_gc_malloc_pointerless (sizeof (scm_t_complex), + "complex")); + SCM_SET_CELL_TYPE (z, scm_tc16_complex); + SCM_COMPLEX_REAL (z) = re; + SCM_COMPLEX_IMAG (z) = im; + return z; } SCM_DEFINE (scm_make_rectangular, "make-rectangular", 2, 0, 0, @@ -7132,8 +7130,13 @@ SCM_DEFINE (scm_make_rectangular, "make-rectangular", 2, 0, 0, SCM_ARG1, FUNC_NAME, "real"); SCM_ASSERT_TYPE (scm_is_real (imaginary_part), imaginary_part, SCM_ARG2, FUNC_NAME, "real"); - return scm_c_make_rectangular (scm_to_double (real_part), - scm_to_double (imaginary_part)); + + /* Return a real if and only if the imaginary_part is an _exact_ 0 */ + if (scm_is_eq (imaginary_part, SCM_INUM0)) + return real_part; + else + return scm_c_make_rectangular (scm_to_double (real_part), + scm_to_double (imaginary_part)); } #undef FUNC_NAME @@ -7156,13 +7159,21 @@ scm_c_make_polar (double mag, double ang) } SCM_DEFINE (scm_make_polar, "make-polar", 2, 0, 0, - (SCM x, SCM y), - "Return the complex number @var{x} * e^(i * @var{y}).") + (SCM mag, SCM ang), + "Return the complex number @var{mag} * e^(i * @var{ang}).") #define FUNC_NAME s_scm_make_polar { - SCM_ASSERT_TYPE (scm_is_real (x), x, SCM_ARG1, FUNC_NAME, "real"); - SCM_ASSERT_TYPE (scm_is_real (y), y, SCM_ARG2, FUNC_NAME, "real"); - return scm_c_make_polar (scm_to_double (x), scm_to_double (y)); + SCM_ASSERT_TYPE (scm_is_real (mag), mag, SCM_ARG1, FUNC_NAME, "real"); + SCM_ASSERT_TYPE (scm_is_real (ang), ang, SCM_ARG2, FUNC_NAME, "real"); + + /* If mag is exact0, return exact0 */ + if (scm_is_eq (mag, SCM_INUM0)) + return SCM_INUM0; + /* Return a real if ang is exact0 */ + else if (scm_is_eq (ang, SCM_INUM0)) + return mag; + else + return scm_c_make_polar (scm_to_double (mag), scm_to_double (ang)); } #undef FUNC_NAME @@ -7189,9 +7200,7 @@ SCM_PRIMITIVE_GENERIC (scm_imag_part, "imag-part", 1, 0, 0, { if (SCM_COMPLEXP (z)) return scm_from_double (SCM_COMPLEX_IMAG (z)); - else if (SCM_REALP (z)) - return flo0; - else if (SCM_I_INUMP (z) || SCM_BIGP (z) || SCM_FRACTIONP (z)) + else if (SCM_I_INUMP (z) || SCM_REALP (z) || SCM_BIGP (z) || SCM_FRACTIONP (z)) return SCM_INUM0; else SCM_WTA_DISPATCH_1 (g_scm_imag_part, z, SCM_ARG1, s_scm_imag_part); @@ -7344,11 +7353,20 @@ SCM_PRIMITIVE_GENERIC (scm_inexact_to_exact, "inexact->exact", 1, 0, 0, "Return an exact number that is numerically closest to @var{z}.") #define FUNC_NAME s_scm_inexact_to_exact { - if (SCM_I_INUMP (z) || SCM_BIGP (z)) + if (SCM_I_INUMP (z) || SCM_BIGP (z) || SCM_FRACTIONP (z)) return z; - else if (SCM_REALP (z)) + else { - if (!DOUBLE_IS_FINITE (SCM_REAL_VALUE (z))) + double val; + + if (SCM_REALP (z)) + val = SCM_REAL_VALUE (z); + else if (SCM_COMPLEXP (z) && SCM_COMPLEX_IMAG (z) == 0.0) + val = SCM_COMPLEX_REAL (z); + else + SCM_WTA_DISPATCH_1 (g_scm_inexact_to_exact, z, 1, s_scm_inexact_to_exact); + + if (!SCM_LIKELY (DOUBLE_IS_FINITE (val))) SCM_OUT_OF_RANGE (1, z); else { @@ -7356,9 +7374,9 @@ SCM_PRIMITIVE_GENERIC (scm_inexact_to_exact, "inexact->exact", 1, 0, 0, SCM q; mpq_init (frac); - mpq_set_d (frac, SCM_REAL_VALUE (z)); + mpq_set_d (frac, val); q = scm_i_make_ratio (scm_i_mpz2num (mpq_numref (frac)), - scm_i_mpz2num (mpq_denref (frac))); + scm_i_mpz2num (mpq_denref (frac))); /* When scm_i_make_ratio throws, we leak the memory allocated for frac... @@ -7367,10 +7385,6 @@ SCM_PRIMITIVE_GENERIC (scm_inexact_to_exact, "inexact->exact", 1, 0, 0, return q; } } - else if (SCM_FRACTIONP (z)) - return z; - else - SCM_WTA_DISPATCH_1 (g_scm_inexact_to_exact, z, 1, s_scm_inexact_to_exact); } #undef FUNC_NAME diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 5a8b31b..96f37df 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -125,6 +125,14 @@ (and (real? obj) (nan? obj))) +;; return true if OBJ is a non-real complex number +;; whose real part is a nan, and whose imaginary +;; part is an inexact zero. +(define (almost-real-nan? obj) + (and (not (real? obj)) + (nan? (real-part obj)) + (zero? (imag-part obj)))) + ;; return true if both the real and imaginary ;; parts of OBJ are NaNs (define (complex-nan? obj) @@ -137,6 +145,12 @@ (and (zero? (real-part obj)) (nan? (imag-part obj)))) +;; return true if OBJ is a non-real complex zero +(define (complex-zero? obj) + (and (zero? obj) + (complex? obj) + (not (real? obj)))) + (define const-e 2.7182818284590452354) (define const-e^2 7.3890560989306502274) (define const-1/e 0.3678794411714423215) @@ -1510,14 +1524,15 @@ ;; * + #+ . #* ("3#." 30.0) ("3#.e0" 30.0) ("3#.#" 30.0) ("3#.#e0" 30.0) ;; Complex: - ("address@hidden" 1.0) ("address@hidden" 1.0) ("address@hidden" 1.0) + ("address@hidden" 1) ("address@hidden" 1) ("address@hidden" 1) + ("address@hidden" 1.0+0i) ("address@hidden" 1+0.0i) ("address@hidden" 1.0-0i) ("2+3i" ,(+ 2 (* 3 +i))) ("4-5i" ,(- 4 (* 5 +i))) ("1+i" 1+1i) ("1-i" 1-1i) ("+1i" 0+1i) ("-1i" 0-1i) ("+i" +1i) ("-i" -1i) ("1.0+.1i" 1.0+0.1i) ("1.0-.1i" 1.0-0.1i) - (".1+.0i" 0.1) - ("1.+.0i" 1.0) + (".1+.0i" 0.1+0.0i) + ("1.+.0i" 1.0+0.0i) (".1+.1i" 0.1+0.1i) ("1e1+.1i" 10+0.1i) )) @@ -1643,6 +1658,8 @@ (pass-if (not (integer? +inf.0))) (pass-if (not (integer? -inf.0))) (pass-if (not (integer? +nan.0))) + (pass-if (not (integer? +inf.0-inf.0i))) + (pass-if (not (integer? +nan.0+nan.0i))) (pass-if (not (integer? 3+4i))) (pass-if (not (integer? #\a))) (pass-if (not (integer? "a"))) @@ -1708,12 +1725,19 @@ (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 (equal? 0.0+0.0i 0.0+0.0i)) + (pass-if (equal? 0.0-0.0i 0.0-0.0i)) + (pass-if (equal? -0.0+0.0i -0.0+0.0i)) (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? 1.0 1.0+0.0i))) + (pass-if (not (equal? 0.0 0.0+0.0i))) + (pass-if (not (equal? 0.0+0.0i 0.0-0.0i))) + (pass-if (not (equal? 0.0+0.0i -0.0+0.0i))) (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)))) @@ -1778,12 +1802,21 @@ (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 (eqv? 0.0+0.0i 0.0+0.0i)) + (pass-if (eqv? 0.0-0.0i 0.0-0.0i)) + (pass-if (eqv? -0.0+0.0i -0.0+0.0i)) + (pass-if (not (eqv? 0.0 -0.0))) + (pass-if (not (eqv? 0.0 0.0+0.0i))) + (pass-if (not (eqv? 0.0+0.0i 0.0-0.0i))) + (pass-if (not (eqv? 0.0+0.0i -0.0+0.0i))) (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? 1.0 1.0+0.0i))) + (pass-if (not (eqv? 0.0 0.0+0.0i))) (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)))) @@ -1835,9 +1868,34 @@ (with-test-prefix "=" (pass-if (documented? =)) - (pass-if (= 0 0)) (pass-if (= 7 7)) (pass-if (= -7 -7)) + (pass-if (= 1.0 1)) + (pass-if (= 1 1.0)) + (pass-if (= -1 -1.0)) + (pass-if (= 0.0 0.0)) + (pass-if (= 0.0 -0.0)) + (pass-if (= 1 1.0+0.0i)) + + (pass-if (= 0 0)) + (pass-if (= 0 0.0)) + (pass-if (= 0 -0.0)) + (pass-if (= 0 0.0+0.0i)) + (pass-if (= 0 0.0-0.0i)) + (pass-if (= 0 0.0+0.0i)) + (pass-if (= 0 -0.0-0.0i)) + + (pass-if (= 0 0)) + (pass-if (= 0.0 0)) + (pass-if (= -0.0 0)) + (pass-if (= 0.0+0.0i 0)) + (pass-if (= 0.0-0.0i 0)) + (pass-if (= 0.0+0.0i 0)) + (pass-if (= -0.0-0.0i 0)) + + (pass-if (= 0.0+0.0i 0.0-0.0i)) + (pass-if (= 0.0+0.0i -0.0+0.0i)) + (pass-if (= (+ 1 fixnum-max) (+ 1 fixnum-max))) (pass-if (= (- fixnum-min 1) (- fixnum-min 1))) (pass-if (not (= 0 1))) @@ -2406,13 +2464,28 @@ (with-test-prefix "zero?" (pass-if (documented? zero?)) - (pass-if (zero? 0)) - (pass-if (not (zero? 7))) + + (pass-if (zero? 0)) + (pass-if (zero? 0.0)) + (pass-if (zero? -0.0)) + + (pass-if (zero? 0.0+0.0i)) + (pass-if (zero? 0.0-0.0i)) + (pass-if (zero? 0.0+0.0i)) + (pass-if (zero? -0.0-0.0i)) + + (pass-if (not (zero? 7))) (pass-if (not (zero? -7))) + (pass-if (not (zero? 1/7))) + (pass-if (not (zero? -inf.0))) + (pass-if (not (zero? +inf.0))) + (pass-if (not (zero? +nan.0))) (pass-if (not (zero? (+ 1 fixnum-max)))) (pass-if (not (zero? (- 1 fixnum-min)))) (pass-if (not (zero? 1.3))) - (pass-if (not (zero? 3.1+4.2i)))) + (pass-if (not (zero? 3.1+4.2i))) + (pass-if (not (zero? 1.0+0.0i))) + (pass-if (not (zero? 0.0-1.0i)))) ;;; ;;; positive? @@ -2789,6 +2862,54 @@ (pass-if "documented?" (documented? +)) + (pass-if "simple" + (and (eqv? 7 (+ 3 4)) + (eqv? 3 (+ 3)) + (eqv? 0 (+)))) + + (pass-if "exactness propagation" + (and (eqv? 8 (+ 3 5)) + (eqv? 8.0 (+ 3 5.0)) + (eqv? 8.0 (+ 3.0 5)) + (eqv? 8.0 (+ 3.0 5.0)) + + (eqv? 5/6 (+ 1/2 1/3)) + (eqv? 5.5 (+ 1/2 5.0)) + (eqv? 3.25 (+ 3.0 1/4)))) + + (pass-if "signed zeroes" + (and (eqv? 0.0 (+ 0.0)) + (eqv? -0.0 (+ -0.0)) + (eqv? 0.0 (+ 0.0 0.0)) + (eqv? 0.0 (+ 0.0 -0.0)) + (eqv? 0.0 (+ -0.0 0.0)) + (eqv? -0.0 (+ -0.0 -0.0)))) + + (pass-if "NaNs" + (and (real-nan? (+ +nan.0 +nan.0)) + (real-nan? (+ 0 +nan.0)) + (real-nan? (+ +nan.0 0)) + (real-nan? (+ 1 +nan.0)) + (real-nan? (+ +nan.0 1)) + (real-nan? (+ -1 +nan.0)) + (real-nan? (+ +nan.0 -1)) + (real-nan? (+ -7/2 +nan.0)) + (real-nan? (+ +nan.0 -7/2)) + (real-nan? (+ 1e20 +nan.0)) + (real-nan? (+ +nan.0 1e20)) + (real-nan? (+ +inf.0 +nan.0)) + (real-nan? (+ +nan.0 +inf.0)) + (real-nan? (+ -inf.0 +nan.0)) + (real-nan? (+ +nan.0 -inf.0)) + (real-nan? (+ (* fixnum-max 2) +nan.0)) + (real-nan? (+ +nan.0 (* fixnum-max 2))))) + + (pass-if "infinities" + (and (eqv? +inf.0 (+ +inf.0 +inf.0)) + (eqv? -inf.0 (+ -inf.0 -inf.0)) + (real-nan? (+ +inf.0 -inf.0)) + (real-nan? (+ -inf.0 +inf.0)))) + ;; The maximum fixnum on a 32-bit architecture: 2^29 - 1. (pass-if "fixnum + fixnum = bignum (32-bit)" (eqv? 536870912 (+ 536870910 2))) @@ -2906,6 +3027,16 @@ (pass-if (eqv? fixnum-min (* (* fixnum-min -1) -1))) (pass-if (equal? fixnum-min (* (* fixnum-min -1) -1)))) + (with-test-prefix "signed zeroes" + (pass-if (eqv? +0.0 (* +0.0 +0.0))) + (pass-if (eqv? -0.0 (* -0.0 +0.0))) + (pass-if (eqv? +0.0 (* -0.0 -0.0))) + (pass-if (eqv? -0.0 (* +0.0 -0.0))) + (pass-if (eqv? +0.0+0.0i (* +i +0.0))) + (pass-if (eqv? +0.0-0.0i (* -i +0.0))) + (pass-if (eqv? -0.0-0.0i (* +i -0.0))) + (pass-if (eqv? -0.0+0.0i (* -i -0.0)))) + (with-test-prefix "exactness propagation" (pass-if (eqv? -0.0 (* 0 -1.0 ))) (pass-if (eqv? 0.0 (* 0 1.0 ))) @@ -2941,10 +3072,10 @@ (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 (real-nan? (* 0 +nan.0 ))) + (pass-if (real-nan? (* +nan.0 0 ))) + (pass-if (almost-real-nan? (* 0 +nan.0+i))) + (pass-if (almost-real-nan? (* +nan.0+i 0 ))) (pass-if (imaginary-nan? (* 0 +nan.0i ))) (pass-if (imaginary-nan? (* +nan.0i 0 ))) @@ -2991,13 +3122,13 @@ (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 (almost-real-nan? (* 0 +inf.0+i))) + (pass-if (almost-real-nan? (* +inf.0+i 0 ))) + (pass-if (almost-real-nan? (* 0 -inf.0+i))) + (pass-if (almost-real-nan? (* -inf.0+i 0 ))) (pass-if (imaginary-nan? (* 0 +inf.0i ))) (pass-if (imaginary-nan? (* +inf.0i 0 ))) @@ -3466,7 +3597,7 @@ (pass-if (eqv? -0.125 (expt -2 -3.0))) (pass-if (eqv? -0.125 (expt -2.0 -3.0))) (pass-if (eqv? 0.25 (expt 2.0 -2.0))) - (pass-if (eqv? (* -1.0 12398 12398) (expt +12398i 2.0))) + (pass-if (test-eqv? (* -1.0+0.0i 12398 12398) (expt +12398i 2.0))) (pass-if (eqv-loosely? +i (expt -1 0.5))) (pass-if (eqv-loosely? +i (expt -1 1/2))) (pass-if (eqv-loosely? 1.0+1.7320508075688i (expt -8 1/3))) @@ -3596,6 +3727,11 @@ ;;; ;;; make-rectangular ;;; + +(with-test-prefix "make-rectangular" + (pass-if (real? (make-rectangular 5.0 0 ))) + (pass-if (not (real? (make-rectangular 5.0 0.0)))) + (pass-if (not (real? (make-rectangular 5.0 -0.0))))) ;;; ;;; make-polar @@ -3606,10 +3742,15 @@ (define (almost= x y) (> 0.01 (magnitude (- x y)))) - (pass-if (= 0 (make-polar 0 0))) - (pass-if (= 0 (make-polar 0 123.456))) - (pass-if (= 1 (make-polar 1 0))) - (pass-if (= -1 (make-polar -1 0))) + (pass-if (real? (make-polar 0 1.0))) + (pass-if (real? (make-polar 5.0 0 ))) + (pass-if (not (real? (make-polar 5.0 0.0)))) + (pass-if (not (real? (make-polar 5.0 -0.0)))) + + (pass-if (eqv? 0 (make-polar 0 0))) + (pass-if (eqv? 0 (make-polar 0 123.456))) + (pass-if (eqv? 1 (make-polar 1 0))) + (pass-if (eqv? -1 (make-polar -1 0))) (pass-if (almost= 0+i (make-polar 1 (* 0.5 pi)))) (pass-if (almost= -1 (make-polar 1 (* 1.0 pi)))) @@ -3634,7 +3775,7 @@ (with-test-prefix "imag-part" (pass-if (documented? imag-part)) - (pass-if (eqv? 0.0 (imag-part 5.0))) + (pass-if (eqv? 0 (imag-part 5.0))) (pass-if (eqv? 5.0 (imag-part +5.0i))) (pass-if (eqv? 0 (imag-part 5))) (pass-if (eqv? 0 (imag-part 1/5))) @@ -3726,7 +3867,7 @@ (pass-if (eqv? -1/8 (integer-expt -2 -3))) (pass-if (eqv? -0.125 (integer-expt -2.0 -3))) (pass-if (eqv? 0.25 (integer-expt 2.0 -2))) - (pass-if (eqv? (* -1.0 12398 12398) (integer-expt +12398.0i 2)))) + (pass-if (test-eqv? (* -1.0+0.0i 12398 12398) (integer-expt +12398.0i 2)))) ;;; -- 1.5.6.5