diff --git a/NEWS b/NEWS index 6781fa0c1..27b52ae75 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,31 @@ Please send Guile bug reports to bug-guile@gnu.org. Note: During the 1.9 series, we will keep an incremental NEWS for the latest prerelease, and a full NEWS corresponding to 1.8 -> 2.0. +Changes since the 1.9.15 prerelease: + +** Improved exactness handling for complex number parsing + +When parsing non-real complex numbers, exactness specifiers are now +applied to each component, as is done in PLT Scheme. For complex +numbers written in rectangular form, exactness specifiers are applied +to the real and imaginary parts before calling scm_make_rectangular. +For complex numbers written in polar form, exactness specifiers are +applied to the magnitude and angle before calling scm_make_polar. + +Previously, exactness specifiers were applied to the number as a whole +_after_ calling scm_make_rectangular or scm_make_polar. + +For example, (string->number "#i5.0+0i") now does the equivalent of: + + (make-rectangular (exact->inexact 5.0) (exact->inexact 0)) + +which yields 5.0+0.0i. Previously it did the equivalent of: + + (exact->inexact (make-rectangular 5.0 0)) + +which yielded 5.0. + + Changes in 1.9.15 (since the 1.9.14 prerelease): ** Formally deprecate omission of port to `format' diff --git a/libguile/numbers.c b/libguile/numbers.c index 3be4478e1..85ca0fdb6 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -4124,7 +4124,7 @@ mem2decimal_from_point (SCM result, SCM mem, static SCM mem2ureal (SCM mem, unsigned int *p_idx, - unsigned int radix, enum t_exactness *p_exactness) + unsigned int radix, enum t_exactness forced_x) { unsigned int idx = *p_idx; SCM result; @@ -4132,7 +4132,7 @@ mem2ureal (SCM mem, unsigned int *p_idx, /* Start off believing that the number will be exact. This changes to INEXACT if we see a decimal point or a hash. */ - enum t_exactness x = EXACT; + enum t_exactness implicit_x = EXACT; if (idx == len) return SCM_BOOL_F; @@ -4148,7 +4148,7 @@ mem2ureal (SCM mem, unsigned int *p_idx, /* Cobble up the fractional part. We might want to set the NaN's mantissa from it. */ idx += 4; - mem2uinteger (mem, &idx, 10, &x); + mem2uinteger (mem, &idx, 10, &implicit_x); *p_idx = idx; return scm_nan (); } @@ -4163,13 +4163,13 @@ mem2ureal (SCM mem, unsigned int *p_idx, return SCM_BOOL_F; else result = mem2decimal_from_point (SCM_INUM0, mem, - p_idx, &x); + p_idx, &implicit_x); } else { SCM uinteger; - uinteger = mem2uinteger (mem, &idx, radix, &x); + uinteger = mem2uinteger (mem, &idx, radix, &implicit_x); if (scm_is_false (uinteger)) return SCM_BOOL_F; @@ -4183,7 +4183,7 @@ mem2ureal (SCM mem, unsigned int *p_idx, if (idx == len) return SCM_BOOL_F; - divisor = mem2uinteger (mem, &idx, radix, &x); + divisor = mem2uinteger (mem, &idx, radix, &implicit_x); if (scm_is_false (divisor)) return SCM_BOOL_F; @@ -4192,7 +4192,7 @@ mem2ureal (SCM mem, unsigned int *p_idx, } else if (radix == 10) { - result = mem2decimal_from_point (uinteger, mem, &idx, &x); + result = mem2decimal_from_point (uinteger, mem, &idx, &implicit_x); if (scm_is_false (result)) return SCM_BOOL_F; } @@ -4202,21 +4202,32 @@ mem2ureal (SCM mem, unsigned int *p_idx, *p_idx = idx; } - /* Update *p_exactness if the number just read was inexact. This is - important for complex numbers, so that a complex number is - treated as inexact overall if either its real or imaginary part - is inexact. - */ - if (x == INEXACT) - *p_exactness = x; + switch (forced_x) + { + case EXACT: + if (SCM_INEXACTP (result)) + return scm_inexact_to_exact (result); + else + return result; + case INEXACT: + if (SCM_INEXACTP (result)) + return result; + else + return scm_exact_to_inexact (result); + case NO_EXACTNESS: + if (implicit_x == INEXACT) + { + if (SCM_INEXACTP (result)) + return result; + else + return scm_exact_to_inexact (result); + } + else + return result; + } - /* When returning an inexact zero, make sure it is represented as a - floating point value so that we can change its sign. - */ - if (scm_is_eq (result, SCM_INUM0) && *p_exactness == INEXACT) - result = flo0; - - return result; + /* We should never get here */ + scm_syserror ("mem2ureal"); } @@ -4224,7 +4235,7 @@ mem2ureal (SCM mem, unsigned int *p_idx, static SCM mem2complex (SCM mem, unsigned int idx, - unsigned int radix, enum t_exactness *p_exactness) + unsigned int radix, enum t_exactness forced_x) { scm_t_wchar c; int sign = 0; @@ -4249,7 +4260,7 @@ mem2complex (SCM mem, unsigned int idx, if (idx == len) return SCM_BOOL_F; - ureal = mem2ureal (mem, &idx, radix, p_exactness); + ureal = mem2ureal (mem, &idx, radix, forced_x); if (scm_is_false (ureal)) { /* input must be either +i or -i */ @@ -4320,7 +4331,7 @@ mem2complex (SCM mem, unsigned int idx, else sign = 1; - angle = mem2ureal (mem, &idx, radix, p_exactness); + angle = mem2ureal (mem, &idx, radix, forced_x); if (scm_is_false (angle)) return SCM_BOOL_F; if (idx != len) @@ -4342,7 +4353,7 @@ mem2complex (SCM mem, unsigned int idx, else { int sign = (c == '+') ? 1 : -1; - SCM imag = mem2ureal (mem, &idx, radix, p_exactness); + SCM imag = mem2ureal (mem, &idx, radix, forced_x); if (scm_is_false (imag)) imag = SCM_I_MAKINUM (sign); @@ -4378,8 +4389,6 @@ scm_i_string_to_number (SCM mem, unsigned int default_radix) unsigned int idx = 0; unsigned int radix = NO_RADIX; enum t_exactness forced_x = NO_EXACTNESS; - enum t_exactness implicit_x = EXACT; - SCM result; size_t len = scm_i_string_length (mem); /* R5RS, section 7.1.1, lexical structure of numbers: */ @@ -4425,37 +4434,9 @@ scm_i_string_to_number (SCM mem, unsigned int default_radix) /* R5RS, section 7.1.1, lexical structure of numbers: */ if (radix == NO_RADIX) - result = mem2complex (mem, idx, default_radix, &implicit_x); - else - result = mem2complex (mem, idx, (unsigned int) radix, &implicit_x); + radix = default_radix; - if (scm_is_false (result)) - return SCM_BOOL_F; - - switch (forced_x) - { - case EXACT: - if (SCM_INEXACTP (result)) - return scm_inexact_to_exact (result); - else - return result; - case INEXACT: - if (SCM_INEXACTP (result)) - return result; - else - return scm_exact_to_inexact (result); - case NO_EXACTNESS: - default: - if (implicit_x == INEXACT) - { - if (SCM_INEXACTP (result)) - return result; - else - return scm_exact_to_inexact (result); - } - else - return result; - } + return mem2complex (mem, idx, radix, forced_x); } SCM @@ -7160,7 +7141,23 @@ scm_c_make_polar (double mag, double ang) s = sin (ang); c = cos (ang); #endif - return scm_c_make_rectangular (mag * c, mag * s); + + /* If s and c are NaNs, this indicates that the angle is a NaN, + infinite, or perhaps simply too large to determine its value + mod 2*pi. However, we know something that the floating-point + implementation doesn't know: We know that s and c are finite. + Therefore, if the magnitude is zero, return a complex zero. + + The reason we check for the NaNs instead of using this case + whenever mag == 0.0 is because when the angle is known, we'd + like to return the correct kind of non-real complex zero: + +0.0+0.0i, -0.0+0.0i, -0.0-0.0i, or +0.0-0.0i, depending + on which quadrant the angle is in. + */ + if (SCM_UNLIKELY (isnan(s)) && isnan(c) && (mag == 0.0)) + return scm_c_make_rectangular (0.0, 0.0); + else + return scm_c_make_rectangular (mag * c, mag * s); } SCM_DEFINE (scm_make_polar, "make-polar", 2, 0, 0, diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 96f37dfc1..1c4630ea9 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -1523,18 +1523,38 @@ ("3.1#e0" 3.1) ;; * + #+ . #* ("3#." 30.0) ("3#.e0" 30.0) ("3#.#" 30.0) ("3#.#e0" 30.0) - ;; Complex: - ("1@0" 1) ("1@+0" 1) ("1@-0" 1) - ("1.0@0" 1.0+0i) ("1@+0.0" 1+0.0i) ("1.0@-0" 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+0.0i) - ("1.+.0i" 1.0+0.0i) - (".1+.1i" 0.1+0.1i) - ("1e1+.1i" 10+0.1i) + )) + #t) + + (pass-if "valid complex number strings" + (for-each (lambda (triple) + (apply + (lambda (str re im) + (let ((z (string->number str))) + (if (or (eq? z #f) + (not (and (eqv? (real-part z) re) + (eqv? (imag-part z) im)))) + (begin + (pk str re im) + (throw 'fail))))) + triple)) + `(("1@0" 1 0) ("1@+0" 1 0) ("1@-0" 1 0) ("1/2@0" 1/2 0) + ("1.0@0" 1.0 0) ("1.0@-0" 1.0 0) + ("#e1@0" 1 0) ("#e1@+0" 1 0) ("#e1@-0" 1 0) ("#e0.5@0.0" 1/2 0) + ("#e1.0@0" 1 0) ("#e1.0@-0" 1 0) + ("#i1@0" 1.0 0.0) ("#i1@+0" 1.0 0.0) ("#i1@-0" 1.0 -0.0) ("#i1/2@0" 0.5 0.0) + ("#i1.0@0" 1.0 0.0) ("#i1.0@-0" 1.0 -0.0) + ("1@+0.0" 1.0 0.0) ("1.0@-0.0" 1.0 -0.0) + ("2+3i" 2.0 3.0) ("4-5i" 4.0 -5.0) + ("1+i" 1.0 1.0) ("1-i" 1.0 -1.0) ("+1i" 0.0 1.0) ("-1i" 0.0 -1.0) + ("+i" 0.0 1.0) ("-i" 0.0 -1.0) + ("1.0+.1i" 1.0 0.1) ("1.0-.1i" 1.0 -0.1) + (".1+.0i" 0.1 0.0) ("1.+.0i" 1.0 0.0) (".1+.1i" 0.1 0.1) + ("1e1+.1i" 10.0 0.1) + ("0@+nan.0" 0 0) ("0@+inf.0" 0 0) ("0@-inf.0" 0 0) + ("0.0@+nan.0" 0.0 0.0) ("0.0@+inf.0" 0.0 0.0) ("0.0@-inf.0" 0.0 0.0) + ("#i0@+nan.0" 0.0 0.0) ("#i0@+inf.0" 0.0 0.0) ("#i0@-inf.0" 0.0 0.0) + ("0.0@1" 0.0 0.0) ("0.0@2" -0.0 0.0) ("0.0@4" -0.0 -0.0) ("0.0@5" 0.0 -0.0) )) #t)