X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flist.lisp;h=da6ca8e60a30b7c9c8b17894fe4dd9b973dc37f7;hb=7f1e94ae961a198e00daf281eb1dc858e5b2dcc7;hp=f7537f3d33bc4b632e150e154c5f51a57cb3ef3e;hpb=ab6672fd5c392b8678681bdda138c4dc9e4de31a;p=sbcl.git

diff --git a/src/code/list.lisp b/src/code/list.lisp
index f7537f3..da6ca8e 100644
--- a/src/code/list.lisp
+++ b/src/code/list.lisp
@@ -18,11 +18,11 @@
 ;;;; -- WHN 20000127
 
 (declaim (maybe-inline
-          tree-equal nth %setnth nthcdr last last1 make-list append
-          nconc nconc2 member-if member-if-not tailp adjoin union
+          tree-equal nth %setnth nthcdr make-list
+          tailp union
           nunion intersection nintersection set-difference nset-difference
           set-exclusive-or nset-exclusive-or subsetp acons
-          assoc-if assoc-if-not rassoc rassoc-if rassoc-if-not subst subst-if
+          subst subst-if
           subst-if-not nsubst nsubst-if nsubst-if-not sublis nsublis))
 
 ;;; These functions perform basic list operations.
@@ -230,28 +230,85 @@
               (fast-nthcdr (mod n i) r-i))
            (declare (type index i)))))))
 
-(defun last1 (list)
-  #!+sb-doc
-  "Return the last cons (not the last element) of a list"
-  (let ((rest list)
-        (list list))
-    (loop (unless (consp rest) (return list))
-          (shiftf list rest (cdr rest)))))
-
-(defun last (list &optional (n 1))
-  #!+sb-doc
-  "Return the last N conses (not the last element!) of a list."
-  (if (eql n 1)
-      (last1 list)
-    (if (typep n 'index)
-        (do ((checked-list list (cdr checked-list))
-             (returned-list list)
-             (index 0 (1+ index)))
-            ((atom checked-list) returned-list)
-          (declare (type index index))
-          (if (>= index n)
-              (pop returned-list)))
-      list)))
+;;; LAST
+;;;
+;;; Transforms in src/compiler/srctran.lisp pick the most specific
+;;; version possible. %LAST/BIGNUM is admittedly somewhat academic...
+(macrolet ((last0-macro ()
+             `(let ((rest list)
+                    (list list))
+                (loop (unless (consp rest)
+                        (return rest))
+                  (shiftf list rest (cdr rest)))))
+           (last1-macro ()
+             `(let ((rest list)
+                    (list list))
+                (loop (unless (consp rest)
+                        (return list))
+                  (shiftf list rest (cdr rest)))))
+           (lastn-macro (type)
+             `(let ((returned-list list)
+                    (checked-list list)
+                    (n (truly-the ,type n)))
+                (declare (,type n))
+                (tagbody
+                 :scan
+                   (pop checked-list)
+                   (when (atom checked-list)
+                     (go :done))
+                   (if (zerop (truly-the ,type (decf n)))
+                       (go :pop)
+                       (go :scan))
+                 :pop
+                   (pop returned-list)
+                   (pop checked-list)
+                   (if (atom checked-list)
+                       (go :done)
+                       (go :pop))
+                 :done)
+                returned-list)))
+
+  (defun %last0 (list)
+    (declare (optimize speed (sb!c::verify-arg-count 0)))
+    (last0-macro))
+
+  (defun %last1 (list)
+    (declare (optimize speed (sb!c::verify-arg-count 0)))
+    (last1-macro))
+
+  (defun %lastn/fixnum (list n)
+    (declare (optimize speed (sb!c::verify-arg-count 0))
+             (type (and unsigned-byte fixnum) n))
+    (case n
+      (1 (last1-macro))
+      (0 (last0-macro))
+      (t (lastn-macro fixnum))))
+
+  (defun %lastn/bignum (list n)
+    (declare (optimize speed (sb!c::verify-arg-count 0))
+             (type (and unsigned-byte bignum) n))
+    (lastn-macro unsigned-byte))
+
+  (defun last (list &optional (n 1))
+    #!+sb-doc
+    "Return the last N conses (not the last element!) of a list."
+    (case n
+      (1 (last1-macro))
+      (0 (last0-macro))
+      (t
+       (typecase n
+         (fixnum
+          (lastn-macro fixnum))
+         (bignum
+          (lastn-macro unsigned-byte)))))))
+
+(define-compiler-macro last (&whole form list &optional (n 1) &environment env)
+  (if (sb!xc:constantp n env)
+      (case (constant-form-value n env)
+        (0 `(%last0 ,list))
+        (1 `(%last1 ,list))
+        (t form))
+      form))
 
 (defun list (&rest args)
   #!+sb-doc
@@ -263,7 +320,9 @@
 
 (defun list* (arg &rest others)
   #!+sb-doc
-  "Return a list of the arguments with last cons a dotted pair"
+  "Return a list of the arguments with last cons a dotted pair."
+  ;; We know the &REST is a proper list.
+  (declare (optimize (sb!c::type-check 0)))
   (cond ((atom others) arg)
         ((atom (cdr others)) (cons arg (car others)))
         (t (do ((x others (cdr x)))
@@ -282,33 +341,61 @@
 (defun append (&rest lists)
   #!+sb-doc
   "Construct a new list by concatenating the list arguments"
+  (declare (truly-dynamic-extent lists) (optimize speed))
   (labels ((fail (object)
              (error 'type-error
                     :datum object
                     :expected-type 'list))
            (append-into (last-cons current rest)
-             "Set (CDR LAST-CONS) to (APPLY #'APPEND CURRENT REST)."
+             ;; Set (CDR LAST-CONS) to (APPLY #'APPEND CURRENT REST).
              (declare (cons last-cons rest))
-             (cond ((consp current)
-                    (append-into (setf (cdr last-cons) (list (car current)))
-                                (cdr current)
-                                rest))
-                   ((not (null current)) (fail current))
-                   ((null (cdr rest)) (setf (cdr last-cons) (car rest)))
-                   (t (append-into last-cons (car rest) (cdr rest)))))
+             (if (listp current)
+                 (if (consp current)
+                     ;; normal case, cdr down the list
+                     (append-into (setf (cdr last-cons) (list (car current)))
+                                  (cdr current)
+                                  rest)
+                     ;; empty list
+                     (let ((more (cdr rest)))
+                       (if (null more)
+                           (setf (cdr last-cons) (car rest))
+                           (append-into last-cons (car rest) more))))
+                 (fail current)))
            (append1 (lists)
              (let ((current (car lists))
                    (rest (cdr lists)))
-               (cond ((null rest) current)
+               (cond ((null rest)
+                      current)
                      ((consp current)
                       (let ((result (truly-the cons (list (car current)))))
                         (append-into result
-                                    (cdr current)
-                                    rest)
+                                     (cdr current)
+                                     rest)
                         result))
-                     ((null current) (append1 rest))
-                     (t (fail current))))))
+                     ((null current)
+                      (append1 rest))
+                     (t
+                      (fail current))))))
     (append1 lists)))
+
+(defun append2 (x y)
+  (declare (optimize speed (sb!c::verify-arg-count 0)))
+  (if (null x)
+      y
+      (let ((result (list (car x))))
+        (do ((more (cdr x) (cdr more))
+             (tail result (cdr tail)))
+            ((null more)
+             (rplacd tail y)
+             result)
+          (rplacd tail (list (car more)))))))
+
+(define-compiler-macro append (&whole form &rest lists)
+  (case (length lists)
+    (0 nil)
+    (1 (car lists))
+    (2 `(append2 ,@lists))
+    (t form)))
 
 ;;;; list copying functions
 
@@ -358,8 +445,21 @@
   #!+sb-doc
   "Recursively copy trees of conses."
   (if (consp object)
-      (cons (copy-tree (car object)) (copy-tree (cdr object)))
+      (let ((result (list (if (consp (car object))
+                              (copy-tree (car object))
+                              (car object)))))
+        (loop for last-cons = result then new-cons
+              for cdr = (cdr object) then (cdr cdr)
+              for car = (if (consp cdr)
+                            (car cdr)
+                            (return (setf (cdr last-cons) cdr)))
+              for new-cons = (list (if (consp car)
+                                       (copy-tree car)
+                                       car))
+              do (setf (cdr last-cons) new-cons))
+        result)
       object))
+
 
 ;;;; more commonly-used list functions
 
@@ -382,47 +482,36 @@
 ;;; and it avoids running down the last argument to NCONC which allows
 ;;; the last argument to be circular.
 (defun nconc (&rest lists)
-  #!+sb-doc
-  "Concatenates the lists given as arguments (by changing them)"
-  (flet ((fail (object)
-           (error 'type-error
-                  :datum object
-                  :expected-type 'list)))
-    (do ((top lists (cdr top)))
-        ((null top) nil)
-      (let ((top-of-top (car top)))
-        (typecase top-of-top
-          (cons
-           (let* ((result top-of-top)
-                  (splice result))
-             (do ((elements (cdr top) (cdr elements)))
-                 ((endp elements))
-               (let ((ele (car elements)))
-                 (typecase ele
-                   (cons (rplacd (last splice) ele)
-                         (setf splice ele))
-                   (null (rplacd (last splice) nil))
-                   (atom (if (cdr elements)
-                             (fail ele)
-                             (rplacd (last splice) ele)))
-                   (t (fail ele)))))
-             (return result)))
-          (null)
-          (atom
-           (if (cdr top)
-               (fail top-of-top)
-               (return top-of-top)))
-          (t (fail top-of-top)))))))
-
-(defun nconc2 (x y)
-  (if (null x) y
-    (let ((z x)
-          (rest (cdr x)))
-      (loop
-       (unless (consp rest)
-         (rplacd z y)
-         (return x))
-       (shiftf z rest (cdr rest))))))
+   #!+sb-doc
+   "Concatenates the lists given as arguments (by changing them)"
+   (declare (truly-dynamic-extent lists) (optimize speed))
+   (flet ((fail (object)
+            (error 'type-error
+                   :datum object
+                   :expected-type 'list)))
+     (do ((top lists (cdr top)))
+         ((null top) nil)
+       (let ((top-of-top (car top)))
+         (typecase top-of-top
+           (cons
+            (let* ((result top-of-top)
+                   (splice result))
+              (do ((elements (cdr top) (cdr elements)))
+                  ((endp elements))
+                (let ((ele (car elements)))
+                  (typecase ele
+                    (cons (rplacd (last splice) ele)
+                          (setf splice ele))
+                    (null (rplacd (last splice) nil))
+                    (atom (if (cdr elements)
+                              (fail ele)
+                              (rplacd (last splice) ele))))))
+              (return result)))
+           (null)
+           (atom
+            (if (cdr top)
+                (fail top-of-top)
+                (return top-of-top))))))))
 
 (defun nreconc (x y)
   #!+sb-doc
@@ -490,15 +579,15 @@
 
 ;;;; functions to alter list structure
 
-(defun rplaca (x y)
+(defun rplaca (cons x)
   #!+sb-doc
-  "Change the CAR of X to Y and return the new X."
-  (rplaca x y))
+  "Change the CAR of CONS to X and return the CONS."
+  (rplaca cons x))
 
-(defun rplacd (x y)
+(defun rplacd (cons x)
   #!+sb-doc
-  "Change the CDR of X to Y and return the new X."
-  (rplacd x y))
+  "Change the CDR of CONS to X and return the CONS."
+  (rplacd cons x))
 
 ;;; The following are for use by SETF.
 
@@ -725,41 +814,45 @@
 
 ;;;; functions for using lists as sets
 
-(defun member (item list &key key (test #'eql testp) (test-not #'eql notp))
+(defun member (item list &key key (test nil testp) (test-not nil notp))
   #!+sb-doc
   "Return the tail of LIST beginning with first element satisfying EQLity,
    :TEST, or :TEST-NOT with the given ITEM."
   (when (and testp notp)
     (error ":TEST and :TEST-NOT were both supplied."))
   (let ((key (and key (%coerce-callable-to-fun key)))
-        (test (if testp (%coerce-callable-to-fun test) test))
-        (test-not (if notp (%coerce-callable-to-fun test-not) test-not)))
-    (declare (type function test test-not))
-    (do ((list list (cdr list)))
-        ((null list) nil)
-      (let ((car (car list)))
-        (when (satisfies-the-test item car)
-          (return list))))))
+        (test (and testp (%coerce-callable-to-fun test)))
+        (test-not (and notp (%coerce-callable-to-fun test-not))))
+    (cond (test
+           (if key
+               (%member-key-test item list key test)
+               (%member-test item list test)))
+          (test-not
+           (if key
+               (%member-key-test-not item list key test-not)
+               (%member-test-not item list test-not)))
+          (t
+           (if key
+               (%member-key item list key)
+               (%member item list))))))
 
 (defun member-if (test list &key key)
   #!+sb-doc
   "Return tail of LIST beginning with first element satisfying TEST."
   (let ((test (%coerce-callable-to-fun test))
         (key (and key (%coerce-callable-to-fun key))))
-    (do ((list list (cdr list)))
-        ((endp list) nil)
-      (if (funcall test (apply-key key (car list)))
-          (return list)))))
+    (if key
+        (%member-if-key test list key)
+        (%member-if test list))))
 
 (defun member-if-not (test list &key key)
   #!+sb-doc
   "Return tail of LIST beginning with first element not satisfying TEST."
   (let ((test (%coerce-callable-to-fun test))
         (key (and key (%coerce-callable-to-fun key))))
-    (do ((list list (cdr list)))
-        ((endp list) ())
-      (if (not (funcall test (apply-key key (car list))))
-          (return list)))))
+    (if key
+        (%member-if-not-key test list key)
+        (%member-if-not test list))))
 
 (defun tailp (object list)
   #!+sb-doc
@@ -775,14 +868,21 @@
   "Add ITEM to LIST unless it is already a member"
   (when (and testp notp)
     (error ":TEST and :TEST-NOT were both supplied."))
-  (let ((key (and key (%coerce-callable-to-fun key))))
-    (declare (inline member))
-    (if (let ((key-val (apply-key key item)))
-          (if notp
-              (member key-val list :test-not test-not :key key)
-              (member key-val list :test test :key key)))
-        list
-        (cons item list))))
+  (let ((key (and key (%coerce-callable-to-fun key)))
+        (test (and testp (%coerce-callable-to-fun test)))
+        (test-not (and notp (%coerce-callable-to-fun test-not))))
+    (cond (test
+           (if key
+               (%adjoin-key-test item list key test)
+               (%adjoin-test item list test)))
+          (test-not
+           (if key
+               (%adjoin-key-test-not item list key test-not)
+               (%adjoin-test-not item list test-not)))
+          (t
+           (if key
+               (%adjoin-key item list key)
+               (%adjoin item list))))))
 
 (defconstant +list-based-union-limit+ 80)
 
@@ -792,7 +892,7 @@
   (declare (inline member))
   (when (and testp notp)
     (error ":TEST and :TEST-NOT were both supplied."))
-  ;; We have to possibilities here: for shortish lists we pick up the
+  ;; We have two possibilities here: for shortish lists we pick up the
   ;; shorter one as the result, and add the other one to it. For long
   ;; lists we use a hash-table when possible.
   (let ((n1 (length list1))
@@ -800,7 +900,7 @@
         (key (and key (%coerce-callable-to-fun key)))
         (test (if notp
                   (let ((test-not-fun (%coerce-callable-to-fun test-not)))
-                    (lambda (x) (not (funcall test-not-fun x))))
+                    (lambda (x y) (not (funcall test-not-fun x y))))
                   (%coerce-callable-to-fun test))))
     (multiple-value-bind (short long n-short)
         (if (< n1 n2)
@@ -841,7 +941,7 @@
   (declare (inline member))
   (when (and testp notp)
     (error ":TEST and :TEST-NOT were both supplied."))
-  ;; We have to possibilities here: for shortish lists we pick up the
+  ;; We have two possibilities here: for shortish lists we pick up the
   ;; shorter one as the result, and add the other one to it. For long
   ;; lists we use a hash-table when possible.
   (let ((n1 (length list1))
@@ -849,7 +949,7 @@
         (key (and key (%coerce-callable-to-fun key)))
         (test (if notp
                   (let ((test-not-fun (%coerce-callable-to-fun test-not)))
-                    (lambda (x) (not (funcall test-not-fun x))))
+                    (lambda (x y) (not (funcall test-not-fun x y))))
                   (%coerce-callable-to-fun test))))
     (multiple-value-bind (short long n-short)
         (if (< n1 n2)
@@ -1057,15 +1157,6 @@
         (error "The lists of keys and data are of unequal length."))
     (setq alist (acons (car x) (car y) alist))))
 
-;;; This is defined in the run-time environment, not just the compile-time
-;;; environment (i.e. not wrapped in EVAL-WHEN (COMPILE EVAL)) because it
-;;; can appear in inline expansions.
-(defmacro assoc-guts (test-expr)
-  `(do ((alist alist (cdr alist)))
-       ((endp alist))
-    (when (and (car alist) ,test-expr)
-      (return (car alist)))))
-
 (defun assoc (item alist &key key (test nil testp) (test-not nil notp))
   #!+sb-doc
   "Return the cons in ALIST whose car is equal (by a given test or EQL) to
@@ -1077,17 +1168,16 @@
         (test-not (and notp (%coerce-callable-to-fun test-not))))
     (cond (test
            (if key
-               (assoc-guts (funcall test item (funcall key (caar alist))))
-               (assoc-guts (funcall test item (caar alist)))))
+               (%assoc-key-test item alist key test)
+               (%assoc-test item alist test)))
           (test-not
            (if key
-               (assoc-guts (not (funcall test-not item
-                                         (funcall key (caar alist)))))
-               (assoc-guts (not (funcall test-not item (caar alist))))))
+               (%assoc-key-test-not item alist key test-not)
+               (%assoc-test-not item alist test-not)))
           (t
            (if key
-               (assoc-guts (eql item (funcall key (caar alist))))
-               (assoc-guts (eql item (caar alist))))))))
+               (%assoc-key item alist key)
+               (%assoc item alist))))))
 
 (defun assoc-if (predicate alist &key key)
   #!+sb-doc
@@ -1096,8 +1186,8 @@
   (let ((predicate (%coerce-callable-to-fun predicate))
         (key (and key (%coerce-callable-to-fun key))))
     (if key
-        (assoc-guts (funcall predicate (funcall key (caar alist))))
-        (assoc-guts (funcall predicate (caar alist))))))
+        (%assoc-if-key predicate alist key)
+        (%assoc-if predicate alist))))
 
 (defun assoc-if-not (predicate alist &key key)
   #!+sb-doc
@@ -1106,8 +1196,8 @@
   (let ((predicate (%coerce-callable-to-fun predicate))
         (key (and key (%coerce-callable-to-fun key))))
     (if key
-        (assoc-guts (not (funcall predicate (funcall key (caar alist)))))
-        (assoc-guts (not (funcall predicate (caar alist)))))))
+        (%assoc-if-not-key predicate alist key)
+        (%assoc-if-not predicate alist))))
 
 (defun rassoc (item alist &key key (test nil testp) (test-not nil notp))
   (declare (list alist))
@@ -1121,17 +1211,16 @@
         (test-not (and notp (%coerce-callable-to-fun test-not))))
     (cond (test
            (if key
-               (assoc-guts (funcall test item (funcall key (cdar alist))))
-               (assoc-guts (funcall test item (cdar alist)))))
+               (%rassoc-key-test item alist key test)
+               (%rassoc-test item alist test)))
           (test-not
            (if key
-               (assoc-guts (not (funcall test-not item
-                                         (funcall key (cdar alist)))))
-               (assoc-guts (not (funcall test-not item (cdar alist))))))
+               (%rassoc-key-test-not item alist key test-not)
+               (%rassoc-test-not item alist test-not)))
           (t
            (if key
-               (assoc-guts (eql item (funcall key (cdar alist))))
-               (assoc-guts (eql item (cdar alist))))))))
+               (%rassoc-key item alist key)
+               (%rassoc item alist))))))
 
 (defun rassoc-if (predicate alist &key key)
   #!+sb-doc
@@ -1140,8 +1229,8 @@
   (let ((predicate (%coerce-callable-to-fun predicate))
         (key (and key (%coerce-callable-to-fun key))))
     (if key
-        (assoc-guts (funcall predicate (funcall key (cdar alist))))
-        (assoc-guts (funcall predicate (cdar alist))))))
+        (%rassoc-if-key predicate alist key)
+        (%rassoc-if predicate alist))))
 
 (defun rassoc-if-not (predicate alist &key key)
   #!+sb-doc
@@ -1150,8 +1239,8 @@
   (let ((predicate (%coerce-callable-to-fun predicate))
         (key (and key (%coerce-callable-to-fun key))))
     (if key
-        (assoc-guts (not (funcall predicate (funcall key (cdar alist)))))
-        (assoc-guts (not (funcall predicate (cdar alist)))))))
+        (%rassoc-if-not-key predicate alist key)
+        (%rassoc-if-not predicate alist))))
 
 ;;;; mapping functions
 
@@ -1217,49 +1306,96 @@
 
 ;;;; Specialized versions
 
-;;; %MEMBER-* and %ASSOC-* function. The transforms for %MEMBER and
-;;; %ASSOC pick the appropriate version. These win because they have
-;;; only positional arguments, the TEST & KEY functions are known to
-;;; exist (or not), and are known to be functions, not function
-;;; designators.
-(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)))
+;;; %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)))
-                             ,(ecase name
-                                     (assoc
-                                      `(when this
-                                         (let ((target (car this)))
-                                           (when (and this ,form)
-                                             (return this)))))
-                                     (member
-                                      `(let ((target this))
-                                         (when ,form
-                                           (return list))))))))))
-               `(progn
-                  ,(%def 'member)
-                  ,(%def 'assoc)))))
+                             ,(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 item target))
+      (eql x target))
   (def ()
-      (eq item target)
+      (eq x target)
     eq)
   (def (key)
-      (eql item (funcall key target)))
+      (eql x (funcall key target)))
   (def (key)
-      (eq item (funcall key target))
+      (eq x (funcall key target))
     eq)
   (def (key test)
-      (funcall test item (funcall key target)))
+      (funcall test x (funcall key target)))
   (def (key test-not)
-      (not (funcall test-not item (funcall key target))))
+      (not (funcall test-not x (funcall key target))))
   (def (test)
-      (funcall test item target))
+      (funcall test x target))
   (def (test-not)
-    (not (funcall test-not item target))))
+      (not (funcall test-not x target))))