From 90a90a0ead1d59ad59b4130c789748574218f1da Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 25 Apr 2008 01:20:24 +0000
Subject: [PATCH] Handle NaN objects specially when comparing them against
 rational numbers.  We should probably do something similar for infinities.

---
 v7/src/runtime/arith.scm | 65 +++++++++++++++++++++++++++-------------
 1 file changed, 44 insertions(+), 21 deletions(-)

diff --git a/v7/src/runtime/arith.scm b/v7/src/runtime/arith.scm
index 591c0c77a..b3224ba78 100644
--- a/v7/src/runtime/arith.scm
+++ b/v7/src/runtime/arith.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: arith.scm,v 1.66 2008/01/30 20:02:28 cph Exp $
+$Id: arith.scm,v 1.67 2008/04/25 01:20:24 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -945,6 +945,11 @@ USA.
       (let ((p flo:significand-digits-base-2))
 	(rat:* (flo:->integer (flo:denormalize f p))
 	       (rat:expt 2 (int:- e-p p)))))))
+
+(define (flo:nan? x)
+  (not (or (flo:positive? x)
+	   (flo:negative? x)
+	   (flo:zero? x))))
 
 (define (real:real? object)
   (or (flonum? object)
@@ -1038,55 +1043,73 @@ USA.
   flo:simplest-exact-rational
   rat:simplest-rational)
 
+(define (real:* x y)
+  (cond ((flonum? x)
+	 (cond ((flonum? y) (flo:* x y))
+	       ((rat:zero? y) y)
+	       (else (flo:* x (rat:->inexact y)))))
+	((rat:zero? x) 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)))
+	(else ((copy rat:/) x y))))
+
 (define (real:= x y)
   (if (flonum? x)
       (if (flonum? y)
 	  (flo:= x y)
-	  (rat:= (flo:->rational x) y))
+	  (compare-flo/rat rat:= x y))
       (if (flonum? y)
-	  (rat:= x (flo:->rational y))
+	  (compare-rat/flo rat:= x y)
 	  ((copy rat:=) x y))))
 
 (define (real:< x y)
   (if (flonum? x)
       (if (flonum? y)
 	  (flo:< x y)
-	  (rat:< (flo:->rational x) y))
+	  (compare-flo/rat rat:< x y))
       (if (flonum? y)
-	  (rat:< x (flo:->rational y))
+	  (compare-rat/flo rat:< x y)
 	  ((copy rat:<) x y))))
 
 (define (real:max x y)
   (if (flonum? x)
       (if (flonum? y)
 	  (if (flo:< x y) y x)
-	  (if (rat:< (flo:->rational x) y) (rat:->inexact y) x))
+	  (if (compare-flo/rat rat:< x y)
+	      (rat:->inexact y)
+	      x))
       (if (flonum? y)
-	  (if (rat:< x (flo:->rational y)) y (rat:->inexact x))
+	  (if (compare-rat/flo rat:< x y)
+	      y
+	      (rat:->inexact x))
 	  (if (rat:< x y) y x))))
 
 (define (real:min x y)
   (if (flonum? x)
       (if (flonum? y)
 	  (if (flo:< x y) x y)
-	  (if (rat:< (flo:->rational x) y) x (rat:->inexact y)))
+	  (if (compare-flo/rat rat:< x y)
+	      x
+	      (rat:->inexact y)))
       (if (flonum? y)
-	  (if (rat:< x (flo:->rational y)) (rat:->inexact x) y)
+	  (if (compare-rat/flo rat:< x y)
+	      (rat:->inexact x)
+	      y)
 	  (if (rat:< x y) x y))))
 
-(define (real:* x y)
-  (cond ((flonum? x)
-	 (cond ((flonum? y) (flo:* x y))
-	       ((rat:zero? y) y)
-	       (else (flo:* x (rat:->inexact y)))))
-	((rat:zero? x) x)
-	((flonum? y) (flo:* (rat:->inexact x) y))
-	(else ((copy rat:*) x y))))
+(define-integrable (compare-flo/rat predicate x y)
+  (if (flo:nan? x)
+      #f
+      (predicate (flo:->rational 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)))
-	(else ((copy rat:/) x y))))
+(define-integrable (compare-rat/flo predicate x y)
+  (if (flo:nan? y)
+      #f
+      (predicate x (flo:->rational y))))
 
 (define (real:even? n)
   ((copy int:even?)
-- 
2.25.1