From c82a1303ace371f8a487f6017c1d935395ad6eec Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Thu, 3 Feb 2011 02:08:26 -0500 Subject: [PATCH] Improved exactness handling for complex number parsing When parsing non-real complex numbers, apply exactness specifiers on per-component basis, 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. There are two kinds of exactness specifiers: forced and implicit. A forced exactness specifier is a "#e" or "#i" prefix at the beginning of the entire number, and applies to both components of a complex number. "#e" causes each component to be made exact, and "#i" causes each component to be made inexact. If no forced exactness specifier is present, then the exactness of each component is determined independently by the presence or absence of a decimal point or hash mark within that component. If a decimal point or hash mark is present, the component is made inexact, otherwise it is made exact. After the exactness specifiers have been applied to each component, they are passed to either scm_make_rectangular or scm_make_polar to produce the final result. Note that this will result in a real number if the imaginary part, magnitude, or angle is an exact 0. Previously, both forced and implicit exactness specifiers 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. * libguile/numbers.c (mem2ureal): Receive a forced exactness specifier (forced_x), create and maintain our own implicit exactness specifier flag local to this component (implicit_x), and apply these exactness specifiers within this function. Previously, we received a pointer to an implicit exactness specifier flag from above, and the exactness specifiers were applied from within scm_i_string_length. (mem2complex): Receive a forced exactness specifier parameter and pass it down to mem2ureal. Previously, we passed down a pointer to an implicit exactness specifier flag instead. (scm_i_string_to_number): No longer create an implicit exactness specifier flag here, and do not apply exactness specifiers here. All we do here now regarding exactness is to parse the "#e" or "#i" prefix (if any) and pass this information down to mem2ureal via mem2complex in the form of an explicit exactness specifier (forced_x). (scm_c_make_polar): If the cosine and sine of the angle are both NaNs and the magnitude is zero, return 0.0+0.0i instead of +nan.0+nan.0i. This case happens when the angle is not finite. * test-suite/tests/numbers.test (string->number): Move the test cases for non-real complex numbers into a separate table in which the expected real and imaginary parts are separate entries. Add several new test cases. --- NEWS | 25 +++++++++ libguile/numbers.c | 113 ++++++++++++++++++++--------------------- test-suite/tests/numbers.test | 44 ++++++++++++---- 3 files changed, 112 insertions(+), 70 deletions(-) diff --git a/NEWS b/NEWS index 6781fa0..27b52ae 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 3be4478..85ca0fd 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; - - /* 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; + 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; + } - 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); - - if (scm_is_false (result)) - return SCM_BOOL_F; + radix = default_radix; - 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 96f37df..1c4630e 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) -- 1.5.6.5