(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))))))))))))
"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))))
((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))))
(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
#!+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)
(defun integer-length (integer)
#!+sb-doc
- "Return the number of significant bits in the absolute value of integer."
+ "Return the number of non-sign bits in the twos-complement representation
+ of INTEGER."
(etypecase integer
(fixnum
(integer-length (truly-the fixnum integer)))