+
+;;; Return a function like FUN, but expecting its (two) arguments in
+;;; the opposite order that FUN does.
+(declaim (inline swapped-args-fun))
+(defun swapped-args-fun (fun)
+ (declare (type function fun))
+ (lambda (x y)
+ (funcall fun y x)))
+
+;;; like CL:ASSERT, but lighter-weight
+;;;
+;;; (As of sbcl-0.6.11.20, we were using some 400 calls to CL:ASSERT
+;;; in SBCL. The CL:ASSERT restarts and whatnot expand into a
+;;; significant amount of code when you multiply them by 400, so
+;;; replacing them with this should reduce the size of the system
+;;; by enough to be worthwhile.)
+(defmacro aver (expr)
+ `(unless ,expr
+ (%failed-aver ,(let ((*package* (find-package :keyword)))
+ (format nil "~S" expr)))))
+(defun %failed-aver (expr-as-string)
+ (error "~@<failed AVER: ~2I~_~S~:>" expr-as-string))
+\f
+;;;; utilities for two-VALUES predicates
+
+;;; sort of like ANY and EVERY, except:
+;;; * We handle two-VALUES predicate functions, as SUBTYPEP does.
+;;; (And if the result is uncertain, then we return (VALUES NIL NIL),
+;;; as SUBTYPEP does.)
+;;; * THING is just an atom, and we apply OP (an arity-2 function)
+;;; successively to THING and each element of LIST.
+(defun any/type (op thing list)
+ (declare (type function op))
+ (let ((certain? t))
+ (dolist (i list (values nil certain?))
+ (multiple-value-bind (sub-value sub-certain?) (funcall op thing i)
+ (if sub-certain?
+ (when sub-value (return (values t t)))
+ (setf certain? nil))))))
+(defun every/type (op thing list)
+ (declare (type function op))
+ (let ((certain? t))
+ (dolist (i list (if certain? (values t t) (values nil nil)))
+ (multiple-value-bind (sub-value sub-certain?) (funcall op thing i)
+ (if sub-certain?
+ (unless sub-value (return (values nil t)))
+ (setf certain? nil))))))