1.0.25.8: fix sxhash bug

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

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index 19e6be9..1c40555 100644 (file)
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -238,7 +238,7 @@
 (defun realpart (number)
   #!+sb-doc
   "Extract the real part of a number."
-  (typecase number
+  (etypecase number
     #!+long-float
     ((complex long-float)
      (truly-the long-float (realpart number)))
@@ -248,13 +248,13 @@
      (truly-the single-float (realpart number)))
     ((complex rational)
      (sb!kernel:%realpart number))
-    (t
+    (number
      number)))
 
 (defun imagpart (number)
   #!+sb-doc
   "Extract the imaginary part of a number."
-  (typecase number
+  (etypecase number
     #!+long-float
     ((complex long-float)
      (truly-the long-float (imagpart number)))
@@ -266,13 +266,14 @@
      (sb!kernel:%imagpart number))
     (float
      (* 0 number))
-    (t
+    (number
      0)))
 
 (defun conjugate (number)
   #!+sb-doc
   "Return the complex conjugate of NUMBER. For non-complex numbers, this is
   an identity."
+  (declare (type number number))
   (if (complexp number)
       (complex (realpart number) (- (imagpart number)))
       number))
@@ -742,7 +743,7 @@
 (defun = (number &rest more-numbers)
   #!+sb-doc
   "Return T if all of its arguments are numerically equal, NIL otherwise."
-  (declare (dynamic-extent more-numbers))
+  (declare (truly-dynamic-extent more-numbers))
   (the number number)
   (do ((nlist more-numbers (cdr nlist)))
       ((atom nlist) t)
@@ -752,7 +753,7 @@
 (defun /= (number &rest more-numbers)
   #!+sb-doc
   "Return T if no two of its arguments are numerically equal, NIL otherwise."
-  (declare (dynamic-extent more-numbers))
+  (declare (truly-dynamic-extent more-numbers))
   (do* ((head (the number number) (car nlist))
         (nlist more-numbers (cdr nlist)))
        ((atom nlist) t)
@@ -766,7 +767,7 @@
 (defun < (number &rest more-numbers)
   #!+sb-doc
   "Return T if its arguments are in strictly increasing order, NIL otherwise."
-  (declare (dynamic-extent more-numbers))
+  (declare (truly-dynamic-extent more-numbers))
   (do* ((n (the number number) (car nlist))
         (nlist more-numbers (cdr nlist)))
        ((atom nlist) t)
@@ -776,7 +777,7 @@
 (defun > (number &rest more-numbers)
   #!+sb-doc
   "Return T if its arguments are in strictly decreasing order, NIL otherwise."
-  (declare (dynamic-extent more-numbers))
+  (declare (truly-dynamic-extent more-numbers))
   (do* ((n (the number number) (car nlist))
         (nlist more-numbers (cdr nlist)))
        ((atom nlist) t)
@@ -786,7 +787,7 @@
 (defun <= (number &rest more-numbers)
   #!+sb-doc
   "Return T if arguments are in strictly non-decreasing order, NIL otherwise."
-  (declare (dynamic-extent more-numbers))
+  (declare (truly-dynamic-extent more-numbers))
   (do* ((n (the number number) (car nlist))
         (nlist more-numbers (cdr nlist)))
        ((atom nlist) t)
@@ -796,7 +797,7 @@
 (defun >= (number &rest more-numbers)
   #!+sb-doc
   "Return T if arguments are in strictly non-increasing order, NIL otherwise."
-  (declare (dynamic-extent more-numbers))
+  (declare (truly-dynamic-extent more-numbers))
   (do* ((n (the number number) (car nlist))
         (nlist more-numbers (cdr nlist)))
        ((atom nlist) t)
@@ -807,7 +808,7 @@
   #!+sb-doc
   "Return the greatest of its arguments; among EQUALP greatest, return
 the first."
-  (declare (dynamic-extent more-numbers))
+  (declare (truly-dynamic-extent more-numbers))
   (do ((nlist more-numbers (cdr nlist))
        (result number))
       ((null nlist) (return result))
@@ -819,7 +820,7 @@ the first."
   #!+sb-doc
   "Return the least of its arguments; among EQUALP least, return
 the first."
-  (declare (dynamic-extent more-numbers))
+  (declare (truly-dynamic-extent more-numbers))
   (do ((nlist more-numbers (cdr nlist))
        (result number))
       ((null nlist) (return result))
@@ -827,15 +828,6 @@ 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