(defun = (number &rest more-numbers)
#!+sb-doc
"Return T if all of its arguments are numerically equal, NIL otherwise."
+ (declare (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))
(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))
(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))
(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))
(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))
(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))
(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))
(do ((nlist more-numbers (cdr nlist))
(result number))
((null nlist) (return result))
((complex (or float rational))
(and (= (realpart x) y)
(zerop (imagpart x))))))
-
-(defun eql (obj1 obj2)
- #!+sb-doc
- "Return T if OBJ1 and OBJ2 represent the same object, otherwise NIL."
- (or (eq obj1 obj2)
- (if (or (typep obj2 'fixnum)
- (not (typep obj2 'number)))
- nil
- (macrolet ((foo (&rest stuff)
- `(typecase obj2
- ,@(mapcar (lambda (foo)
- (let ((type (car foo))
- (fn (cadr foo)))
- `(,type
- (and (typep obj1 ',type)
- (,fn obj1 obj2)))))
- stuff))))
- (foo
- (single-float eql)
- (double-float eql)
- #!+long-float
- (long-float eql)
- (bignum
- (lambda (x y)
- (zerop (bignum-compare x y))))
- (ratio
- (lambda (x y)
- (and (eql (numerator x) (numerator y))
- (eql (denominator x) (denominator y)))))
- (complex
- (lambda (x y)
- (and (eql (realpart x) (realpart y))
- (eql (imagpart x) (imagpart y))))))))))
\f
;;;; logicals
(number-dispatch ((u integer) (v integer))
((fixnum fixnum)
(locally
- (declare (optimize (speed 3) (safety 0)))
+ (declare (optimize (speed 3) (safety 0)))
(do ((k 0 (1+ k))
(u (abs u) (ash u -1))
(v (abs v) (ash v -1)))
(setq temp (- u v))
(when (zerop temp)
(let ((res (ash u k)))
- (declare (type (signed-byte 31) res)
+ (declare (type sb!vm:signed-word res)
(optimize (inhibit-warnings 3)))
(return res))))))
- (declare (type (mod 30) k)
- (type (signed-byte 31) u v)))))
+ (declare (type (mod #.sb!vm:n-word-bits) k)
+ (type sb!vm:signed-word u v)))))
((bignum bignum)
(bignum-gcd u v))
((bignum fixnum)