From 3d300fd85b6db7db6b697bed2be674641ba42a59 Mon Sep 17 00:00:00 2001
From: Taylor R Campbell <campbell@mumble.net>
Date: Tue, 4 Jun 2013 05:22:42 +0000
Subject: [PATCH] Fix various infinity and NaN screw cases for <, MIN, MAX, *,
 and /.

Behaviour is as prescribed by IEEE 754.  Most of the changes that
involve FLO:NAN? use it only in mixed-exactness branches, which are
not particularly performance-critical anyway.  Eventually we ought to
make FLO:NAN? and FLO:FINITE? open-codable primitives, and add
FLO:INFINITE?, FLO:NORMAL?, and FLO:SUBNORMAL? likewise.
---
 src/runtime/arith.scm | 58 +++++++++++++++++++++++++++----------------
 1 file changed, 37 insertions(+), 21 deletions(-)

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index 0b6b769df..7fbed2182 100644
--- a/src/runtime/arith.scm
+++ b/src/runtime/arith.scm
@@ -1045,44 +1045,57 @@ USA.
 (define (real:* x y)
   (cond ((flonum? x)
 	 (cond ((flonum? y) (flo:* x y))
-	       ((rat:zero? y) y)
+	       ((rat:zero? y) (if (flo:nan? x) x y))
 	       (else (flo:* x (rat:->inexact y)))))
-	((rat:zero? x) x)
+	((rat:zero? x) (if (and (flonum? y) (flo:nan? y)) y x))
 	((flonum? y) (flo:* (rat:->inexact x) y))
 	(else ((copy rat:*) x y))))
 
 (define (real:/ x y)
   (cond ((flonum? x) (flo:/ x (if (flonum? y) y (rat:->inexact y))))
-	((flonum? y) (if (rat:zero? x) x (flo:/ (rat:->inexact x) y)))
+	((flonum? y)
+	 (if (and (rat:zero? x) (not (flo:nan? y)))
+	     x
+	     (flo:/ (rat:->inexact x) y)))
 	(else ((copy rat:/) x y))))
 
 (define (real:= x y)
   (if (flonum? x)
       (if (flonum? y)
 	  (flo:= x y)
-	  (compare-flo/rat rat:= x y))
+	  (flo=rat? x y))
       (if (flonum? y)
-	  (compare-rat/flo rat:= x y)
+	  (rat=flo? x y)
 	  ((copy rat:=) x y))))
 
+(define-integrable (flo=rat? x y)
+  (and (flo:finite? x)
+       (rat:= (flo:->rational x) y)))
+
+(define-integrable (rat=flo? x y)
+  (flo=rat? y x))
+
 (define (real:< x y)
   (if (flonum? x)
       (if (flonum? y)
 	  (flo:< x y)
-	  (compare-flo/rat rat:< x y))
+	  (flo<rat? x y #f))
       (if (flonum? y)
-	  (compare-rat/flo rat:< x y)
+	  (rat<flo? x y #f)
 	  ((copy rat:<) x y))))
 
 (define (real:max x y)
   (if (flonum? x)
       (if (flonum? y)
-	  (if (flo:< x y) y x)
-	  (if (compare-flo/rat rat:< x y)
+	  (cond ((flo:<= x y) y)
+		((flo:<= y x) x)
+		((flo:nan? x) y)
+		(else x))
+	  (if (flo<rat? x y #t)
 	      (rat:->inexact y)
 	      x))
       (if (flonum? y)
-	  (if (compare-rat/flo rat:< x y)
+	  (if (rat<flo? x y #f)
 	      y
 	      (rat:->inexact x))
 	  (if (rat:< x y) y x))))
@@ -1090,25 +1103,28 @@ USA.
 (define (real:min x y)
   (if (flonum? x)
       (if (flonum? y)
-	  (if (flo:< x y) x y)
-	  (if (compare-flo/rat rat:< x y)
+	  (cond ((flo:<= x y) x)
+		((flo:<= y x) y)
+		((flo:nan? y) x)
+		(else y))
+	  (if (flo<rat? x y #f)
 	      x
 	      (rat:->inexact y)))
       (if (flonum? y)
-	  (if (compare-rat/flo rat:< x y)
+	  (if (rat<flo? x y #t)
 	      (rat:->inexact x)
 	      y)
 	  (if (rat:< x y) x y))))
 
-(define-integrable (compare-flo/rat predicate x y)
-  (if (flo:nan? x)
-      #f
-      (predicate (flo:->rational x) y)))
+(define-integrable (flo<rat? x y if-nan)
+  (cond ((flo:finite? x) (rat:< (flo:->rational x) y))
+	((flo:nan? x) if-nan)
+	(else (flo:< x 0.))))
 
-(define-integrable (compare-rat/flo predicate x y)
-  (if (flo:nan? y)
-      #f
-      (predicate x (flo:->rational y))))
+(define-integrable (rat<flo? x y if-nan)
+  (cond ((flo:finite? y) (rat:< x (flo:->rational y)))
+	((flo:nan? y) if-nan)
+	(else (flo:< 0. y))))
 
 (define (real:even? n)
   ((copy int:even?)
-- 
2.25.1