+
+;;;; Specialized versions
+
+;;; %ADJOIN-*, %ASSOC-*, %MEMBER-*, and %RASSOC-* functions. Deftransforms
+;;; delegate to TRANSFORM-LIST-PRED-SEEK and TRANSFORM-LIST-ITEM-SEEK which
+;;; pick the appropriate versions. 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 &optional conditional)
+ (let* ((body-loop
+ `(do ((list list (cdr list)))
+ ((null list) nil)
+ (declare (list list))
+ (let ((this (car list)))
+ ,(let ((cxx (if (char= #\A (char (string name) 0))
+ 'car ; assoc, assoc-if, assoc-if-not
+ 'cdr))) ; rassoc, rassoc-if, rassoc-if-not
+ (ecase name
+ ((assoc rassoc)
+ (if funs
+ `(when this
+ (let ((target (,cxx 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 (,cxx this)))
+ (when (and ,form this)
+ (return this)))))
+ ((assoc-if assoc-if-not rassoc-if rassoc-if-not)
+ (aver (equal '(eql x) (subseq form 0 2)))
+ `(when this
+ (let ((target (,cxx this)))
+ (,conditional (funcall ,@(cdr form))
+ (return this)))))
+ (member
+ `(let ((target this))
+ (when ,form
+ (return list))))
+ ((member-if member-if-not)
+ (aver (equal '(eql x) (subseq form 0 2)))
+ `(let ((target this))
+ (,conditional (funcall ,@(cdr form))
+ (return list))))
+ (adjoin
+ `(let ((target this))
+ (when ,form
+ (return t)))))))))
+ (body (if (eq 'adjoin name)
+ `(if (let ,(when (member 'key funs)
+ `((x (funcall key x))))
+ ,body-loop)
+ list
+ (cons x list))
+ body-loop)))
+ `(defun ,(intern (format nil "%~A~{-~A~}~@[-~A~]" name funs variant))
+ (x list ,@funs)
+ (declare (optimize speed (sb!c::verify-arg-count 0)))
+ ,@(when funs `((declare (function ,@funs))))
+ ,@(unless (member name '(member assoc adjoin rassoc)) `((declare (function x))))
+ ,body))))
+ `(progn
+ ,(%def 'adjoin)
+ ,(%def 'assoc)
+ ,(%def 'member)
+ ,(%def 'rassoc)
+ ,@(when (and (not variant) (member funs '(() (key)) :test #'equal))
+ (list (%def 'member-if 'when)
+ (%def 'member-if-not 'unless)
+ (%def 'assoc-if 'when)
+ (%def 'assoc-if-not 'unless)
+ (%def 'rassoc-if 'when)
+ (%def 'rassoc-if-not 'unless)))))))
+ (def ()
+ (eql x target))
+ (def ()
+ (eq x target)
+ eq)
+ (def (key)
+ (eql x (funcall key target)))
+ (def (key)
+ (eq x (funcall key target))
+ eq)
+ (def (key test)
+ (funcall test x (funcall key target)))
+ (def (key test-not)
+ (not (funcall test-not x (funcall key target))))
+ (def (test)
+ (funcall test x target))
+ (def (test-not)
+ (not (funcall test-not x target))))