+
+;;;; Specialized versions
+
+;;; %MEMBER-* and %ASSOC-* functions. The transforms for MEMBER and
+;;; ASSOC pick the appropriate version. These win because they have
+;;; only positional arguments, the TEST, TEST-NOT & KEY functions are
+;;; known to exist (or not), and are known to be functions instead of
+;;; function designators. We are also able to transform many common
+;;; cases to -EQ versions, which are substantially faster then EQL
+;;; using ones.
+(macrolet
+ ((def (funs form &optional variant)
+ (flet ((%def (name)
+ `(defun ,(intern (format nil "%~A~{-~A~}~@[-~A~]" name funs variant))
+ (item list ,@funs)
+ (declare (optimize speed))
+ ,@(when funs `((declare (function ,@funs))))
+ (do ((list list (cdr list)))
+ ((null list) nil)
+ (declare (list list))
+ (let ((this (car list)))
+ ,(ecase name
+ (assoc
+ (if funs
+ `(when this
+ (let ((target (car this)))
+ (when ,form
+ (return this))))
+ ;; If there is no TEST/TEST-NOT or
+ ;; KEY, do the EQ/EQL test first,
+ ;; before checking for NIL.
+ `(let ((target (car this)))
+ (when (and ,form this)
+ (return this)))))
+ (member
+ `(let ((target this))
+ (when ,form
+ (return list))))))))))
+ `(progn
+ ,(%def 'member)
+ ,(%def 'assoc)))))
+ (def ()
+ (eql item target))
+ (def ()
+ (eq item target)
+ eq)
+ (def (key)
+ (eql item (funcall key target)))
+ (def (key)
+ (eq item (funcall key target))
+ eq)
+ (def (key test)
+ (funcall test item (funcall key target)))
+ (def (key test-not)
+ (not (funcall test-not item (funcall key target))))
+ (def (test)
+ (funcall test item target))
+ (def (test-not)
+ (not (funcall test-not item target))))