Hi!

Attached a patch that partially takes your suggestions into
account.

I decided to go with option #1, as this is what C99's
fmin(3)/fmax(3) provides. I thought it would make sense to
have at least "fpmin"/"fpmax" being consistent with "min"/"max",
but we can't use fmax(3) in the C runtime as this would require
allocating which is difficult in this context (see "C_i_flonum_max").

So C_i_flonum_max/_min add a nan-check and return any non-nan
value unchanged. I changed "max"/"min" to check for nans and
expose (hopefully) the same behaviour.

I am reluctant to bother with negative zero - it is an implementation
artifact of IEEE and nonsensical, IMHO. Once you start
adding rules for "consistent" handling of negative zeroes, people
will give it semantic meaning, which I'd rather not encourage.


cheers,
felix

From d4190395d90ab4d7cf873bdcf2b241dfa79daecd Mon Sep 17 00:00:00 2001
From: felix <[email protected]>
Date: Sun, 2 Aug 2026 16:08:26 +0200
Subject: [PATCH] Make max/min more consistent with respect to nan's.

(Following suggestions by Peter McGoron)
---
 chicken.h              | 12 ++++++++----
 library.scm            | 38 ++++++++++++++++++++++++++------------
 tests/numbers-test.scm | 17 +++++++++++++++++
 3 files changed, 51 insertions(+), 16 deletions(-)

diff --git a/chicken.h b/chicken.h
index 73651e93..c7b9a4d8 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1114,6 +1114,8 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
 #define C_isnan(f)                 isnan(f)
 #define C_isinf(f)                 isinf(f)
 #define C_isfinite(f)              isfinite(f)
+#define C_isgreater(x, y)       isgreater(x, y)
+#define C_isless(x, y)            isless(x, y)
 
 #define C_stack_overflow_check    C_stack_check1(C_stack_overflow(NULL))
 
@@ -3201,8 +3203,9 @@ 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);
-
-  return xf < yf ? x : y;
+  if(C_isnan(xf)) return y;
+  if(C_isnan(yf)) return x;
+  return C_isless(xf, yf) ? x : y;
 }
 
 
@@ -3211,8 +3214,9 @@ 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);
-
-  return xf > yf ? x : y;
+  if(C_isnan(xf)) return y;
+  if(C_isnan(yf)) return x;
+  return C_isgreater(xf, yf) ? x : y;
 }
 
 inline static C_word C_u_i_integer_signum(C_word x)
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)
-- 
2.50.1

Reply via email to