0.9.1.1:

[sbcl.git] / src / code / numbers.lisp

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index c0440f3..d525b8a 100644 (file)
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -388,7 +388,7 @@
                (cond ((eql t1 0) 0)
                      ((eql g2 1)
                       (%make-ratio t1 (* t2 dy)))
-                     (T (let* ((nn (truncate t1 g2))
+                     (t (let* ((nn (truncate t1 g2))
                                (t3 (truncate dy g2))
                                (nd (if (eql t2 1) t3 (* t2 t3))))
                           (if (eql nd 1) nn (%make-ratio nn nd))))))))))))
@@ -744,7 +744,7 @@
   "Return T if all of its arguments are numerically equal, NIL otherwise."
   (the number number)
   (do ((nlist more-numbers (cdr nlist)))
-      ((atom nlist) T)
+      ((atom nlist) t)
      (declare (list nlist))
      (if (not (= (car nlist) number)) (return nil))))
 
@@ -756,7 +756,7 @@
        ((atom nlist) t)
      (declare (list nlist))
      (unless (do* ((nl nlist (cdr nl)))
-                 ((atom nl) T)
+                 ((atom nl) t)
               (declare (list nl))
               (if (= head (car nl)) (return nil)))
        (return nil))))
@@ -819,6 +819,15 @@ the first."
      (declare (type real number result))
      (if (< (car nlist) result) (setq result (car nlist)))))
 
+(defconstant most-positive-exactly-single-float-fixnum
+  (min #xffffff most-positive-fixnum))
+(defconstant most-negative-exactly-single-float-fixnum
+  (max #x-ffffff most-negative-fixnum))
+(defconstant most-positive-exactly-double-float-fixnum
+  (min #x1fffffffffffff most-positive-fixnum))
+(defconstant most-negative-exactly-double-float-fixnum
+  (max #x-1fffffffffffff most-negative-fixnum))
+
 (eval-when (:compile-toplevel :execute)
 
 ;;; The INFINITE-X-FINITE-Y and INFINITE-Y-FINITE-X args tell us how
@@ -838,6 +847,40 @@ the first."
     #!+long-float
     ((long-float (foreach single-float double-float))
      (,op x (coerce y 'long-float)))
+    ((fixnum (foreach single-float double-float))
+     (if (float-infinity-p y)
+         ,infinite-y-finite-x
+         ;; If the fixnum has an exact float representation, do a
+         ;; float comparison. Otherwise do the slow float -> ratio
+         ;; conversion.
+        (multiple-value-bind (lo hi)
+            (case '(dispatch-type y)
+              ('single-float
+               (values most-negative-exactly-single-float-fixnum
+                       most-positive-exactly-single-float-fixnum))
+              ('double-float
+               (values most-negative-exactly-double-float-fixnum
+                       most-positive-exactly-double-float-fixnum)))
+          (if (<= lo y hi)
+              (,op (coerce x '(dispatch-type y)) y)
+              (,op x (rational y))))))
+    (((foreach single-float double-float) fixnum)
+     (if (eql y 0)
+         (,op x (coerce 0 '(dispatch-type x)))
+         (if (float-infinity-p x)
+             ,infinite-x-finite-y
+             ;; Likewise
+            (multiple-value-bind (lo hi)
+                (case '(dispatch-type x)
+                  ('single-float
+                   (values most-negative-exactly-single-float-fixnum
+                           most-positive-exactly-single-float-fixnum))
+                  ('double-float
+                   (values most-negative-exactly-double-float-fixnum
+                           most-positive-exactly-double-float-fixnum)))
+              (if (<= lo y hi)
+                  (,op x (coerce y '(dispatch-type x)))
+                  (,op (rational x) y))))))
     (((foreach single-float double-float) double-float)
      (,op (coerce x 'double-float) y))
     ((double-float single-float)