(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)))
(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)))
(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))
(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)
(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)
(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)
(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)
(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)
(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)
#!+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))
#!+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))
(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