~ chicken-core (master) 4a139317c9a04476caa0a1298dd19af518141a52
commit 4a139317c9a04476caa0a1298dd19af518141a52
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Jul 14 21:17:50 2026 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Tue Jul 14 21:17:50 2026 +0200
reader changes to parse inexact negative zero in imaginary part of complex numbers
diff --git a/library.scm b/library.scm
index c88fdd61..b136c9e2 100644
--- a/library.scm
+++ b/library.scm
@@ -3227,26 +3227,35 @@ EOF
(scan-ureal next (eq? sign 'neg) cplx?)))
(else (scan-ureal next (eq? sign 'neg) cplx?))))))))
(number (and-let* ((r1 (scan-real offset #f)))
- (case (and (cdr r1) (string-ref str (cdr r1)))
- ((#f) (car r1))
- ((#\i #\I) (and (fx= len (fx+ (cdr r1) 1))
+ (let ((nf (and r1 (zero? (car r1)) negative)))
+ (case (and (cdr r1) (string-ref str (cdr r1)))
+ ((#f) (car r1))
+ ((#\i #\I) (and (fx= len (fx+ (cdr r1) 1))
(or (eq? (string-ref str offset) #\+) ; ugh
(eq? (string-ref str offset) #\-))
- (make-rectangular 0 (car r1))))
- ((#\+ #\-)
- (set! seen-hashes? #f) ; Reset flag for imaginary part
- (and-let* ((r2 (scan-real (cdr r1) #t))
- ((cdr r2))
- ((fx= len (fx+ (cdr r2) 1)))
- ((or (eq? (string-ref str (cdr r2)) #\i)
- (eq? (string-ref str (cdr r2)) #\I))))
- (make-rectangular (car r1) (car r2))))
- ((#\@)
- (set! seen-hashes? #f) ; Reset flag for angle
- (and-let* ((r2 (scan-real (fx+ (cdr r1) 1) #f))
- ((not (cdr r2))))
- (make-polar (car r1) (car r2))))
- (else #f)))))
+ (make-rectangular 0 (if nf (- (car r1)) (car r1)))))
+ ((#\+ #\-)
+ (set! seen-hashes? #f) ; Reset flag for imaginary part
+ (set! negative #f)
+ (and-let* ((r2 (scan-real (cdr r1) #t))
+ ((cdr r2))
+ ((fx= len (fx+ (cdr r2) 1)))
+ ((or (eq? (string-ref str (cdr r2)) #\i)
+ (eq? (string-ref str (cdr r2)) #\I))))
+ (make-rectangular
+ (car r1)
+ (let ((n2 (if (and (exact? (car r2)) (eq? exactness 'i))
+ (exact->inexact (car r2))
+ (car r2))))
+ (if (and negative (>= n2 0) (not (eqv? n2 -0.0)))
+ (- n2)
+ n2)))))
+ ((#\@)
+ (set! seen-hashes? #f) ; Reset flag for angle
+ (and-let* ((r2 (scan-real (fx+ (cdr r1) 1) #f))
+ ((not (cdr r2))))
+ (make-polar (car r1) (car r2))))
+ (else #f))))))
(and number (if (eq? exactness 'i)
(let ((r (exact->inexact number)))
;; Stupid hack because flonums can represent negative zero,
Trap