- ;; KLUDGE: This stuff might well blow up if we tried to execute it
- ;; when cross-compiling. But since for the foreseeable future the
- ;; only code we'll try to cross-compile is SBCL itself, and SBCL is
- ;; built without using SATISFIES types, it's arguably not important
- ;; to worry about this. -- WHN 19990210.
- (let ((fun (second hairy-spec)))
- (cond ((and (consp fun)
- (eq (car fun) 'lambda))
- (values (not (null (funcall (coerce fun 'function) obj)))
- t))
- ((and (symbolp fun) (fboundp fun))
- (values (not (null (funcall fun obj))) t))
- (t
- (values nil nil))))))))))
+ (let ((predicate-name (second hairy-spec)))
+ (declare (type symbol predicate-name)) ; by ANSI spec of SATISFIES
+ (if (fboundp predicate-name)
+ (values (not (null (funcall predicate-name obj))) t)
+ (values nil nil)))))))))