On Sat, Jun 29, 2019 at 03:26:54PM +0200, Peter Bex wrote: > Hi all, > > Attached is a patch for #1627. > > I'm not happy with the hacky way the reader deals with these, but I could > not really come up with a clean solution for it. Suggestions for > improvement are welcome.
There was a small bug in the previous patch; it would also carry the sign of the exponent into the final result, which is definitely not correct. Very obscure case, but the nice numbers test suite from S7 found it :) I also found another case: if there was an exponent at all, it would not propagate the sign (so -0e1 would be 0.0 instead of -0.0). I had to move the go-inexact! call from scan-exponent down into scan-ureal, where the sign is known. This is fine, as the other call to scan-exponent was inside scan-decimal-tail, before which scan-ureal already calls go-inexact! as well. This new patch has additional test cases for this as well. Cheers, Peter
From c134553e2fd3c2374e0c988d63e85802aa7dccdd Mon Sep 17 00:00:00 2001 From: Peter Bex <pe...@more-magic.net> Date: Sat, 29 Jun 2019 15:19:17 +0200 Subject: [PATCH] Distinguish between IEEE fp positive and negative zero To be able to read these numbers, we need a bit of a hacky workaround because we read integers and then convert them to inexact when needed, but of course proper integers don't distinguish between positive and negative zero. To write these numbers, we need to use signbit(f) instead of checking whether the number is negative in a "normal" way, because -0.0 is not smaller than 0. To compare them, we have the bizarre rule that = will not distinguish, while equal? and eqv? will. Fixes #1627, thanks to John Cowan for pointing out this regression from CHICKEN 4.x (CHICKEN 4 with the numbers egg has the same bug though). --- NEWS | 5 +++++ chicken.h | 9 ++++++++- library.scm | 27 ++++++++++++++++++--------- runtime.c | 5 +++-- tests/library-tests.scm | 14 ++++++++++++++ tests/numbers-string-conversion-tests.scm | 10 ++++++++++ 6 files changed, 58 insertions(+), 12 deletions(-) diff --git a/NEWS b/NEWS index e15ec4e3..da5dc62f 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,10 @@ 5.1.1 +- Runtime system + - IEEE floating point negative zero is now properly handled: it can + be read, written and distinguished by eqv? and equal?, but not = + (fixes #1627, thanks to John Cowan). + - Compiler - Fixed a bug in lfa2 pass which caused "if" or "cond" nodes to be incorrectly unboxed if the "else" branch had a flonum result type diff --git a/chicken.h b/chicken.h index 88bf4ab3..34a052cf 100644 --- a/chicken.h +++ b/chicken.h @@ -2622,6 +2622,12 @@ inline static int C_memcasecmp(const char *x, const char *y, unsigned int len) return 0; } +inline static C_word C_ub_i_flonum_eqvp(double x, double y) +{ + /* This can distinguish between -0.0 and +0.0 */ + return x == y && signbit(x) == signbit(y); +} + inline static C_word basic_eqvp(C_word x, C_word y) { return (x == y || @@ -2630,7 +2636,8 @@ inline static C_word basic_eqvp(C_word x, C_word y) C_block_header(x) == C_block_header(y) && ((C_block_header(x) == C_FLONUM_TAG && - C_flonum_magnitude(x) == C_flonum_magnitude(y)) || + C_ub_i_flonum_eqvp(C_flonum_magnitude(x), + C_flonum_magnitude(y))) || (C_block_header(x) == C_BIGNUM_TAG && C_block_header(y) == C_BIGNUM_TAG && diff --git a/library.scm b/library.scm index 994efc4d..965fe1c5 100644 --- a/library.scm +++ b/library.scm @@ -2398,9 +2398,12 @@ EOF ;; Shorthand for readability. TODO: Replace other C_subchar calls with this (define-inline (%subchar s i) (##core#inline "C_subchar" s i)) (define (##sys#string->compnum radix str offset exactness) - (define (go-inexact!) + (define negative #f) + (define (go-inexact! neg?) ;; Go inexact unless exact was requested (with #e prefix) - (unless (eq? exactness 'e) (set! exactness 'i))) + (unless (eq? exactness 'e) + (set! exactness 'i) + (set! negative (or negative neg?)))) (define (safe-exponent value e) (and e (cond ((not value) 0) @@ -2465,7 +2468,7 @@ EOF str start (car end) radix neg?))) (when hashes ; Eeewww. Feeling dirty yet? (set! seen-hashes? #t) - (go-inexact!)) + (go-inexact! neg?)) (cons num (cdr end)))))) (scan-exponent (lambda (start) @@ -2474,7 +2477,6 @@ EOF ((#\+) 'pos) ((#\-) 'neg) (else #f)))) (and-let* ((start (if sign (fx+ start 1) start)) (end (scan-digits start))) - (go-inexact!) (cons (##core#inline_allocate ("C_s_a_i_digits_to_integer" 5) str start (car end) radix (eq? sign 'neg)) @@ -2508,18 +2510,19 @@ EOF (if (and (fx> len (fx+ start 1)) (eq? radix 10) (eq? (%subchar str start) #\.)) (begin - (go-inexact!) + (go-inexact! neg?) (scan-decimal-tail (fx+ start 1) neg? #f)) (and-let* ((end (scan-digits+hashes start neg? #f))) (case (and (cdr end) (%subchar str (cdr end))) ((#\.) - (go-inexact!) + (go-inexact! neg?) (and (eq? radix 10) (if (fx> len (fx+ (cdr end) 1)) (scan-decimal-tail (fx+ (cdr end) 1) neg? (car end)) (cons (car end) #f)))) ((#\e #\s #\f #\d #\l #\E #\S #\F #\D #\L) + (go-inexact! neg?) (and-let* (((eq? radix 10)) ((fx> len (cdr end))) (ee (scan-exponent (fx+ (cdr end) 1))) @@ -2557,7 +2560,7 @@ EOF (cons (if (eq? sign 'neg) -1 1) next)) ((and (fx<= (fx+ next 5) len) (string-ci=? (substring str next (fx+ next 5)) "inf.0")) - (go-inexact!) + (go-inexact! (eq? sign 'neg)) (cons (if (eq? sign 'neg) -inf.0 +inf.0) (and (fx< (fx+ next 5) len) (fx+ next 5)))) @@ -2567,7 +2570,7 @@ EOF (or (and sign (fx<= (fx+ next 5) len) (string-ci=? (substring str next (fx+ next 5)) "nan.0") - (begin (go-inexact!) + (begin (go-inexact! (eq? sign 'neg)) (cons (make-nan) (and (fx< (fx+ next 5) len) (fx+ next 5))))) @@ -2595,7 +2598,13 @@ EOF (make-polar (car r1) (car r2)))) (else #f))))) (and number (if (eq? exactness 'i) - (exact->inexact number) + (let ((r (exact->inexact number))) + ;; Stupid hack because flonums can represent + ;; negative zero, but we're coming from an exact + ;; which has no such thing. + (if (and negative (zero? r)) + (fpneg r) + r)) ;; Ensure we didn't encounter +inf.0 or +nan.0 with #e (and (finite? number) number))))) diff --git a/runtime.c b/runtime.c index 30620a22..5b4e1277 100644 --- a/runtime.c +++ b/runtime.c @@ -4791,7 +4791,8 @@ C_regparm C_word C_fcall C_equalp(C_word x, C_word y) if((header = C_block_header(x)) != C_block_header(y)) return 0; else if((bits = header & C_HEADER_BITS_MASK) & C_BYTEBLOCK_BIT) { if(header == C_FLONUM_TAG && C_block_header(y) == C_FLONUM_TAG) - return C_flonum_magnitude(x) == C_flonum_magnitude(y); + return C_ub_i_flonum_eqvp(C_flonum_magnitude(x), + C_flonum_magnitude(y)); else return !C_memcmp(C_data_pointer(x), C_data_pointer(y), header & C_HEADER_SIZE_MASK); } else if(header == C_SYMBOL_TAG) return 0; @@ -11179,7 +11180,7 @@ void C_ccall C_flonum_to_string(C_word c, C_word *av) } if(f == 0.0 || (C_modf(f, &m) == 0.0 && log2(fa) < C_WORD_SIZE)) { /* Use fast int code */ - if(f < 0) { + if(signbit(f)) { p = to_n_nary((C_uword)-f, radix, 1, 1); } else { p = to_n_nary((C_uword)f, radix, 0, 1); diff --git a/tests/library-tests.scm b/tests/library-tests.scm index eb380d73..05906492 100644 --- a/tests/library-tests.scm +++ b/tests/library-tests.scm @@ -58,6 +58,20 @@ (assert (not (integer? "foo"))) ; XXX number missing +;; Negative vs positive zero (see #1627) +(assert (not (eqv? 0.0 -0.0))) +(assert (not (equal? 0.0 -0.0))) +(assert (= 0.0 -0.0)) + +(assert (not (positive? 0.0))) +(assert (not (negative? 0.0))) +(assert (zero? 0.0)) + +(assert (not (positive? -0.0))) +(assert (not (negative? -0.0))) +(assert (zero? -0.0)) + +;; Exactness (assert (exact? 1)) (assert (not (exact? 1.0))) (assert (not (exact? 1.1))) diff --git a/tests/numbers-string-conversion-tests.scm b/tests/numbers-string-conversion-tests.scm index b71282de..ad673a46 100644 --- a/tests/numbers-string-conversion-tests.scm +++ b/tests/numbers-string-conversion-tests.scm @@ -507,3 +507,13 @@ (error "No error on invalid base" b)))) (condition-case (check-base 1) ((exn type) 'ok)) (condition-case (check-base 37) ((exn type) 'ok))) + +;; #1627 - Even though R7RS Scheme allows not distinguishing negative +;; zero (as in the test above), we do. +(assert (string=? "-0.0" (number->string -0.0))) +(assert (string=? "0.0" (number->string +0.0))) +(assert (eqv? -0.0 (string->number "-0.0"))) +(assert (eqv? 0.0 (string->number "+0.0"))) +(assert (eqv? 0.0 (string->number "0.0"))) +(assert (eqv? -0.0 (string->number "-0e1"))) +(assert (eqv? 0.0 (string->number "0e-1"))) -- 2.11.0
signature.asc
Description: PGP signature
_______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers