~ chicken-core (master) 85a6b3f6059c0bf1e3488235805092621fc8b5d2
commit 85a6b3f6059c0bf1e3488235805092621fc8b5d2
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Aug 2 16:08:26 2026 +0200
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Thu Aug 6 11:56:51 2026 +0200
Make max/min more consistent with respect to nan's.
(Following suggestions by Peter McGoron)
Signed-off-by: Peter Bex <peter@more-magic.net>
diff --git a/chicken.h b/chicken.h
index 73651e93..4786907e 100644
--- a/chicken.h
+++ b/chicken.h
@@ -3201,7 +3201,8 @@ inline static C_word C_i_flonum_min(C_word x, C_word y)
double
xf = C_flonum_magnitude(x),
yf = C_flonum_magnitude(y);
-
+ if(C_isnan(xf)) return y;
+ if(C_isnan(yf)) return x;
return xf < yf ? x : y;
}
@@ -3211,7 +3212,8 @@ inline static C_word C_i_flonum_max(C_word x, C_word y)
double
xf = C_flonum_magnitude(x),
yf = C_flonum_magnitude(y);
-
+ if(C_isnan(xf)) return y;
+ if(C_isnan(yf)) return x;
return xf > yf ? x : y;
}
diff --git a/library.scm b/library.scm
index 736a1e9f..d418024a 100644
--- a/library.scm
+++ b/library.scm
@@ -2621,25 +2621,39 @@ EOF
(set! scheme#max
(lambda (x1 . xs)
- (let loop ((i (##core#inline "C_i_flonump" x1)) (m x1) (xs xs))
- (##sys#check-number m 'max)
+ (##sys#check-number x1 'max)
+ (let loop ((i (##core#inline "C_i_flonump" x1))
+ (m x1)
+ (xs xs)
+ (n (##core#inline "C_i_nanp" x1)))
(if (null? xs)
(if i (exact->inexact m) m)
- (let ((h (##sys#slot xs 0)))
- (loop (or i (##core#inline "C_i_flonump" h))
- (if (> h m) h m)
- (##sys#slot xs 1)) ) ) ) ))
+ (let* ((h (##sys#slot xs 0))
+ (_ (##sys#check-number h 'max))
+ (f (##core#inline "C_i_flonump" h))
+ (nxt (##sys#slot xs 1)))
+ (cond ((##core#inline "C_i_nanp" h) (loop i m nxt n))
+ (n (loop (or i f) h nxt #f))
+ ((> h m) (loop (or i f) h nxt #f))
+ (else (loop (or i f) m nxt n))))))))
(set! scheme#min
(lambda (x1 . xs)
- (let loop ((i (##core#inline "C_i_flonump" x1)) (m x1) (xs xs))
- (##sys#check-number m 'min)
+ (##sys#check-number x1 'min)
+ (let loop ((i (##core#inline "C_i_flonump" x1))
+ (m x1)
+ (xs xs)
+ (n (##core#inline "C_i_nanp" x1)))
(if (null? xs)
(if i (exact->inexact m) m)
- (let ((h (##sys#slot xs 0)))
- (loop (or i (##core#inline "C_i_flonump" h))
- (if (< h m) h m)
- (##sys#slot xs 1)) ) ) ) ))
+ (let* ((h (##sys#slot xs 0))
+ (_ (##sys#check-number h 'min))
+ (f (##core#inline "C_i_flonump" h))
+ (nxt (##sys#slot xs 1)))
+ (cond ((##core#inline "C_i_nanp" h) (loop i m nxt n))
+ (n (loop (or i f) h nxt #f))
+ ((< h m) (loop (or i f) h nxt #f))
+ (else (loop (or i f) m nxt n))))))))
(set! scheme#exp
(lambda (n)
diff --git a/tests/numbers-test.scm b/tests/numbers-test.scm
index 29877539..2898f2fb 100644
--- a/tests/numbers-test.scm
+++ b/tests/numbers-test.scm
@@ -854,6 +854,23 @@
(test-equal "max" (max 3 4) 4)
(test-equal "max" (max 3.9 4) 4.0)
+ (test-equal "max" (max +nan.0 1.0 2.0) 2.0)
+ (test-equal "max" (max 1.0 +nan.0 2.0) 2.0)
+ (test-equal "max" (max 1.0 2.0 +nan.0) 2.0)
+ (test-equal "max" (max +nan.0 1.0 2) 2.0)
+ (test-equal "max" (max 1.0 +nan.0 2) 2.0)
+ (test-equal "max" (max 1.0 2 +nan.0) 2.0)
+ (test-assert "max" (nan? (max +nan.0)))
+ (test-assert "max" (nan? (max +nan.0 +nan.0)))
+
+ (test-equal "min" (min +nan.0 1.0 2.0) 1.0)
+ (test-equal "min" (min 1.0 +nan.0 2.0) 1.0)
+ (test-equal "min" (min 1.0 2.0 +nan.0) 1.0)
+ (test-equal "min" (min +nan.0 1 2.0) 1.0)
+ (test-equal "min" (min 1 +nan.0 2.0) 1.0)
+ (test-equal "min" (min 1 2.0 +nan.0) 1.0)
+ (test-assert "min" (nan? (min +nan.0)))
+ (test-assert "min" (nan? (min +nan.0 +nan.0)))
(test-equal "modulo" (modulo 13 4) 1)
(test-equal "modulo" (modulo 13.0 4) 1.0)
Trap