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.

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index 0b6b769dffd79677c552b63f364dfe763b89edbb..7fbed21826180ceb20f31e9d3d6075baef8e1a0e 100644 (file)
--- 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))))
 \f
 (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))))
 \f
 (define (real:even? n)
   ((copy int:even?)