;;;; -- WHN 20000127
(declaim (maybe-inline
- tree-equal list-length nth %setnth nthcdr last make-list append
- copy-list copy-alist copy-tree revappend nconc nreconc butlast
- nbutlast ldiff member member-if member-if-not tailp adjoin union
+ tree-equal nth %setnth nthcdr last make-list append
+ nconc member member-if member-if-not tailp adjoin union
nunion intersection nintersection set-difference nset-difference
- set-exclusive-or nset-exclusive-or subsetp acons pairlis assoc
+ set-exclusive-or nset-exclusive-or subsetp acons assoc
assoc-if assoc-if-not rassoc rassoc-if rassoc-if-not subst subst-if
subst-if-not nsubst nsubst-if nsubst-if-not sublis nsublis))
-;;; These functions perform basic list operations:
-(defun car (list) #!+sb-doc "Returns the 1st object in a list." (car list))
+;;; These functions perform basic list operations.
+(defun car (list) #!+sb-doc "Return the 1st object in a list." (car list))
(defun cdr (list)
- #!+sb-doc "Returns all but the first object in a list."
+ #!+sb-doc "Return all but the first object in a list."
(cdr list))
-(defun cadr (list) #!+sb-doc "Returns the 2nd object in a list." (cadr list))
-(defun cdar (list) #!+sb-doc "Returns the cdr of the 1st sublist." (cdar list))
-(defun caar (list) #!+sb-doc "Returns the car of the 1st sublist." (caar list))
+(defun cadr (list) #!+sb-doc "Return the 2nd object in a list." (cadr list))
+(defun cdar (list) #!+sb-doc "Return the cdr of the 1st sublist." (cdar list))
+(defun caar (list) #!+sb-doc "Return the car of the 1st sublist." (caar list))
(defun cddr (list)
- #!+sb-doc "Returns all but the 1st two objects of a list."
+ #!+sb-doc "Return all but the 1st two objects of a list."
(cddr list))
(defun caddr (list)
- #!+sb-doc "Returns the 1st object in the cddr of a list."
+ #!+sb-doc "Return the 1st object in the cddr of a list."
(caddr list))
(defun caadr (list)
- #!+sb-doc "Returns the 1st object in the cadr of a list."
+ #!+sb-doc "Return the 1st object in the cadr of a list."
(caadr list))
(defun caaar (list)
- #!+sb-doc "Returns the 1st object in the caar of a list."
+ #!+sb-doc "Return the 1st object in the caar of a list."
(caaar list))
(defun cdaar (list)
- #!+sb-doc "Returns the cdr of the caar of a list."
+ #!+sb-doc "Return the cdr of the caar of a list."
(cdaar list))
(defun cddar (list)
- #!+sb-doc "Returns the cdr of the cdar of a list."
+ #!+sb-doc "Return the cdr of the cdar of a list."
(cddar list))
(defun cdddr (list)
- #!+sb-doc "Returns the cdr of the cddr of a list."
+ #!+sb-doc "Return the cdr of the cddr of a list."
(cdddr list))
(defun cadar (list)
- #!+sb-doc "Returns the car of the cdar of a list."
+ #!+sb-doc "Return the car of the cdar of a list."
(cadar list))
(defun cdadr (list)
- #!+sb-doc "Returns the cdr of the cadr of a list."
+ #!+sb-doc "Return the cdr of the cadr of a list."
(cdadr list))
(defun caaaar (list)
- #!+sb-doc "Returns the car of the caaar of a list."
+ #!+sb-doc "Return the car of the caaar of a list."
(caaaar list))
(defun caaadr (list)
- #!+sb-doc "Returns the car of the caadr of a list."
+ #!+sb-doc "Return the car of the caadr of a list."
(caaadr list))
(defun caaddr (list)
- #!+sb-doc "Returns the car of the caddr of a list."
+ #!+sb-doc "Return the car of the caddr of a list."
(caaddr list))
(defun cadddr (list)
- #!+sb-doc "Returns the car of the cdddr of a list."
+ #!+sb-doc "Return the car of the cdddr of a list."
(cadddr list))
(defun cddddr (list)
- #!+sb-doc "Returns the cdr of the cdddr of a list."
+ #!+sb-doc "Return the cdr of the cdddr of a list."
(cddddr list))
(defun cdaaar (list)
- #!+sb-doc "Returns the cdr of the caaar of a list."
+ #!+sb-doc "Return the cdr of the caaar of a list."
(cdaaar list))
(defun cddaar (list)
- #!+sb-doc "Returns the cdr of the cdaar of a list."
+ #!+sb-doc "Return the cdr of the cdaar of a list."
(cddaar list))
(defun cdddar (list)
- #!+sb-doc "Returns the cdr of the cddar of a list."
+ #!+sb-doc "Return the cdr of the cddar of a list."
(cdddar list))
(defun caadar (list)
- #!+sb-doc "Returns the car of the cadar of a list."
+ #!+sb-doc "Return the car of the cadar of a list."
(caadar list))
(defun cadaar (list)
- #!+sb-doc "Returns the car of the cdaar of a list."
+ #!+sb-doc "Return the car of the cdaar of a list."
(cadaar list))
(defun cadadr (list)
- #!+sb-doc "Returns the car of the cdadr of a list."
+ #!+sb-doc "Return the car of the cdadr of a list."
(cadadr list))
(defun caddar (list)
- #!+sb-doc "Returns the car of the cddar of a list."
+ #!+sb-doc "Return the car of the cddar of a list."
(caddar list))
(defun cdaadr (list)
- #!+sb-doc "Returns the cdr of the caadr of a list."
+ #!+sb-doc "Return the cdr of the caadr of a list."
(cdaadr list))
(defun cdadar (list)
- #!+sb-doc "Returns the cdr of the cadar of a list."
+ #!+sb-doc "Return the cdr of the cadar of a list."
(cdadar list))
(defun cdaddr (list)
- #!+sb-doc "Returns the cdr of the caddr of a list."
+ #!+sb-doc "Return the cdr of the caddr of a list."
(cdaddr list))
(defun cddadr (list)
- #!+sb-doc "Returns the cdr of the cdadr of a list."
+ #!+sb-doc "Return the cdr of the cdadr of a list."
(cddadr list))
(defun cons (se1 se2)
- #!+sb-doc "Returns a list with se1 as the car and se2 as the cdr."
+ #!+sb-doc "Return a list with SE1 as the CAR and SE2 as the CDR."
(cons se1 se2))
\f
(declaim (maybe-inline tree-equal-test tree-equal-test-not))
(defun tree-equal (x y &key (test #'eql) test-not)
#!+sb-doc
- "Returns T if X and Y are isomorphic trees with identical leaves."
+ "Return T if X and Y are isomorphic trees with identical leaves."
(if test-not
(tree-equal-test-not x y test-not)
(tree-equal-test x y test)))
(defun endp (object)
#!+sb-doc
- "The recommended way to test for the end of a list. True if Object is nil,
- false if Object is a cons, and an error for any other types of arguments."
+ "This is the recommended way to test for the end of a proper list. It
+ returns true if OBJECT is NIL, false if OBJECT is a CONS, and an error
+ for any other type of OBJECT."
(endp object))
(defun list-length (list)
#!+sb-doc
- "Returns the length of the given List, or Nil if the List is circular."
+ "Return the length of the given List, or Nil if the List is circular."
(do ((n 0 (+ n 2))
(y list (cddr y))
(z list (cdr z)))
(defun nth (n list)
#!+sb-doc
- "Returns the nth object in a list where the car is the zero-th element."
+ "Return the nth object in a list where the car is the zero-th element."
(car (nthcdr n list)))
(defun first (list)
#!+sb-doc
- "Returns the 1st object in a list or NIL if the list is empty."
+ "Return the 1st object in a list or NIL if the list is empty."
(car list))
(defun second (list)
- "Returns the 2nd object in a list or NIL if there is no 2nd object."
+ "Return the 2nd object in a list or NIL if there is no 2nd object."
(cadr list))
(defun third (list)
#!+sb-doc
- "Returns the 3rd object in a list or NIL if there is no 3rd object."
+ "Return the 3rd object in a list or NIL if there is no 3rd object."
(caddr list))
(defun fourth (list)
#!+sb-doc
- "Returns the 4th object in a list or NIL if there is no 4th object."
+ "Return the 4th object in a list or NIL if there is no 4th object."
(cadddr list))
(defun fifth (list)
#!+sb-doc
- "Returns the 5th object in a list or NIL if there is no 5th object."
+ "Return the 5th object in a list or NIL if there is no 5th object."
(car (cddddr list)))
(defun sixth (list)
#!+sb-doc
- "Returns the 6th object in a list or NIL if there is no 6th object."
+ "Return the 6th object in a list or NIL if there is no 6th object."
(cadr (cddddr list)))
(defun seventh (list)
#!+sb-doc
- "Returns the 7th object in a list or NIL if there is no 7th object."
+ "Return the 7th object in a list or NIL if there is no 7th object."
(caddr (cddddr list)))
(defun eighth (list)
#!+sb-doc
- "Returns the 8th object in a list or NIL if there is no 8th object."
+ "Return the 8th object in a list or NIL if there is no 8th object."
(cadddr (cddddr list)))
(defun ninth (list)
#!+sb-doc
- "Returns the 9th object in a list or NIL if there is no 9th object."
+ "Return the 9th object in a list or NIL if there is no 9th object."
(car (cddddr (cddddr list))))
(defun tenth (list)
#!+sb-doc
- "Returns the 10th object in a list or NIL if there is no 10th object."
+ "Return the 10th object in a list or NIL if there is no 10th object."
(cadr (cddddr (cddddr list))))
(defun rest (list)
#!+sb-doc
(defun last (list &optional (n 1))
#!+sb-doc
- "Returns the last N conses (not the last element!) of a list."
+ "Return the last N conses (not the last element!) of a list."
(declare (type index n))
(do ((checked-list list (cdr checked-list))
(returned-list list)
(defun list (&rest args)
#!+sb-doc
- "Returns constructs and returns a list of its arguments."
+ "Return constructs and returns a list of its arguments."
args)
;;; List* is done the same as list, except that the last cons is made a
(defun list* (arg &rest others)
#!+sb-doc
- "Returns a list of the arguments with last cons a dotted pair"
+ "Return a list of the arguments with last cons a dotted pair"
(cond ((atom others) arg)
((atom (cdr others)) (cons arg (car others)))
(t (do ((x others (cdr x)))
(defun copy-list (list)
#!+sb-doc
- "Returns a new list which is EQUAL to LIST."
+ "Return a new list which is EQUAL to LIST."
;; The list is copied correctly even if the list is not terminated
;; by NIL. The new list is built by CDR'ing SPLICE which is always
;; at the tail of the new list.
(defun copy-alist (alist)
#!+sb-doc
- "Returns a new association list which is EQUAL to ALIST."
+ "Return a new association list which is EQUAL to ALIST."
(if (atom alist)
alist
(let ((result
(defun revappend (x y)
#!+sb-doc
- "Returns (append (reverse x) y)"
+ "Return (append (reverse x) y)."
(do ((top x (cdr top))
(result y (cons (car top) result)))
((endp top) result)))
(defun nreconc (x y)
#!+sb-doc
- "Returns (nconc (nreverse x) y)"
+ "Return (nconc (nreverse x) y)."
(do ((1st (cdr x) (if (atom 1st) 1st (cdr 1st)))
(2nd x 1st) ;2nd follows first down the list.
(3rd y 2nd)) ;3rd follows 2nd down the list.
(declare (type index result)))))
(declare (ftype (function (t) index) count-conses))
(defun butlast (list &optional (n 1))
- (let* ((n-conses-in-list (count-conses list))
- (n-remaining-to-copy (- n-conses-in-list n)))
- (declare (type fixnum n-remaining-to-copy))
- (when (plusp n-remaining-to-copy)
- (do* ((result (list (first list)))
- (rest (rest list) (rest rest))
- (splice result))
- ((zerop (decf n-remaining-to-copy))
- result)
- (setf splice
- (setf (cdr splice)
- (list (first rest))))))))
- (defun nbutlast (list &optional (n 1))
(let ((n-conses-in-list (count-conses list)))
- (unless (< n-conses-in-list n)
- (setf (cdr (nthcdr (- n-conses-in-list n 1) list))
- nil)
- list))))
+ (cond ((zerop n)
+ ;; (We can't use SUBSEQ in this case because LIST isn't
+ ;; necessarily a proper list, but SUBSEQ expects a
+ ;; proper sequence. COPY-LIST isn't so fussy.)
+ (copy-list list))
+ ((>= n n-conses-in-list)
+ nil)
+ (t
+ ;; (LIST isn't necessarily a proper list in this case
+ ;; either, and technically SUBSEQ wants a proper
+ ;; sequence, but no reasonable implementation of SUBSEQ
+ ;; will actually walk down to the end of the list to
+ ;; check, and since we're calling our own implementation
+ ;; we know it's reasonable, so it's OK.)
+ (subseq list 0 (- n-conses-in-list n))))))
+ (defun nbutlast (list &optional (n 1))
+ (if (zerop n)
+ list
+ (let ((n-conses-in-list (count-conses list)))
+ (unless (<= n-conses-in-list n)
+ (setf (cdr (nthcdr (- n-conses-in-list n 1) list))
+ nil)
+ list)))))
(defun ldiff (list object)
- "Returns a new list, whose elements are those of List that appear before
- Object. If Object is not a tail of List, a copy of List is returned.
- List must be a proper list or a dotted list."
+ "Return a new list, whose elements are those of LIST that appear before
+ OBJECT. If OBJECT is not a tail of LIST, a copy of LIST is returned.
+ LIST must be a proper list or a dotted list."
(do* ((list list (cdr list))
(result (list ()))
(splice result))
(defun rplaca (x y)
#!+sb-doc
- "Changes the car of x to y and returns the new x."
+ "Change the CAR of X to Y and return the new X."
(rplaca x y))
(defun rplacd (x y)
#!+sb-doc
- "Changes the cdr of x to y and returns the new x."
+ "Change the CDR of X to Y and return the new X."
(rplacd x y))
;;; The following are for use by SETF.
(defun %rplacd (x val) (rplacd x val) val)
+;;; Set the Nth element of LIST to NEWVAL.
(defun %setnth (n list newval)
(declare (type index n))
- #!+sb-doc
- "Sets the Nth element of List (zero based) to Newval."
(do ((count n (1- count))
(list list (cdr list)))
((endp list)
;;;; :KEY arg optimization to save funcall of IDENTITY
;;; APPLY-KEY saves us a function call sometimes.
-;;; This is not wrapped in an (EVAL-WHEN (COMPILE EVAL) ..)
-;;; because this is used in seq.lisp and sort.lisp.
+;;; This isn't wrapped in an (EVAL-WHEN (COMPILE EVAL) ..)
+;;; because it's used in seq.lisp and sort.lisp.
(defmacro apply-key (key element)
`(if ,key
(funcall ,key ,element)
,element))
-
-(defun identity (thing)
- #!+sb-doc
- "Returns what was passed to it."
- thing)
-
-(defun complement (function)
- #!+sb-doc
- "Builds a new function that returns T whenever FUNCTION returns NIL and
- NIL whenever FUNCTION returns T."
- #'(lambda (&optional (arg0 nil arg0-p) (arg1 nil arg1-p) (arg2 nil arg2-p)
- &rest more-args)
- (not (cond (more-args (apply function arg0 arg1 arg2 more-args))
- (arg2-p (funcall function arg0 arg1 arg2))
- (arg1-p (funcall function arg0 arg1))
- (arg0-p (funcall function arg0))
- (t (funcall function))))))
-
-(defun constantly (value &optional (val1 nil val1-p) (val2 nil val2-p)
- &rest more-values)
- #!+sb-doc
- "Builds a function that always returns VALUE, and posisbly MORE-VALUES."
- (cond (more-values
- (let ((list (list* value val1 val2 more-values)))
- #'(lambda ()
- (declare (optimize-interface (speed 3) (safety 0)))
- (values-list list))))
- (val2-p
- #'(lambda ()
- (declare (optimize-interface (speed 3) (safety 0)))
- (values value val1 val2)))
- (val1-p
- #'(lambda ()
- (declare (optimize-interface (speed 3) (safety 0)))
- (values value val1)))
- (t
- #'(lambda ()
- (declare (optimize-interface (speed 3) (safety 0)))
- value))))
\f
;;;; macros for (&KEY (KEY #'IDENTITY) (TEST #'EQL TESTP) (TEST-NOT NIL NOTP))
-;;; Use these with the following keyword args:
+;;; Use these with the following &KEY args:
(defmacro with-set-keys (funcall)
- `(cond ((and testp notp) (error "Test and test-not both supplied."))
+ `(cond ((and testp notp) (error ":TEST and :TEST-NOT were both supplied."))
(notp ,(append funcall '(:key key :test-not test-not)))
(t ,(append funcall '(:key key :test test)))))
(defun member (item list &key key (test #'eql testp) (test-not nil notp))
#!+sb-doc
- "Returns tail of list beginning with first element satisfying EQLity,
- :test, or :test-not with a given item."
+ "Return the tail of LIST beginning with first element satisfying EQLity,
+ :TEST, or :TEST-NOT with the given ITEM."
(do ((list list (cdr list)))
((null list) nil)
(let ((car (car list)))
(defun member-if (test list &key key)
#!+sb-doc
- "Returns tail of list beginning with first element satisfying test(element)"
+ "Return tail of LIST beginning with first element satisfying TEST."
(do ((list list (Cdr list)))
((endp list) nil)
(if (funcall test (apply-key key (car list)))
(defun member-if-not (test list &key key)
#!+sb-doc
- "Returns tail of list beginning with first element not satisfying test(el)"
+ "Return tail of LIST beginning with first element not satisfying TEST."
(do ((list list (cdr list)))
((endp list) ())
(if (not (funcall test (apply-key key (car list))))
(defun tailp (object list)
#!+sb-doc
- "Returns true if Object is the same as some tail of List, otherwise
- returns false. List must be a proper list or a dotted list."
+ "Return true if OBJECT is the same as some tail of LIST, otherwise
+ returns false. LIST must be a proper list or a dotted list."
(do ((list list (cdr list)))
((atom list) (eql list object))
(if (eql object list)
(defun adjoin (item list &key key (test #'eql) (test-not nil notp))
#!+sb-doc
- "Add item to list unless it is already a member"
+ "Add ITEM to LIST unless it is already a member"
(declare (inline member))
(if (let ((key-val (apply-key key item)))
(if notp
;;; order.
(defun union (list1 list2 &key key (test #'eql testp) (test-not nil notp))
#!+sb-doc
- "Returns the union of list1 and list2."
+ "Return the union of LIST1 and LIST2."
(declare (inline member))
(when (and testp notp) (error "Test and test-not both supplied."))
(let ((res list2))
(push elt res)))
res))
-;;; Destination and source are setf-able and many-evaluable. Sets the source
-;;; to the cdr, and "conses" the 1st elt of source to destination.
+;;; Destination and source are SETF-able and many-evaluable. Set the
+;;; SOURCE to the CDR, and "cons" the 1st elt of source to DESTINATION.
;;;
;;; FIXME: needs a more mnemonic name
(defmacro steve-splice (source destination)
(defun nunion (list1 list2 &key key (test #'eql testp) (test-not nil notp))
#!+sb-doc
- "Destructively returns the union list1 and list2."
+ "Destructively return the union of LIST1 and LIST2."
(declare (inline member))
(if (and testp notp)
- (error "Test and test-not both supplied."))
+ (error ":TEST and :TEST-NOT were both supplied."))
(let ((res list2)
(list1 list1))
(do ()
(defun intersection (list1 list2 &key key
(test #'eql testp) (test-not nil notp))
#!+sb-doc
- "Returns the intersection of list1 and list2."
+ "Return the intersection of LIST1 and LIST2."
(declare (inline member))
(if (and testp notp)
(error "Test and test-not both supplied."))
(defun nintersection (list1 list2 &key key
(test #'eql testp) (test-not nil notp))
#!+sb-doc
- "Destructively returns the intersection of list1 and list2."
+ "Destructively return the intersection of LIST1 and LIST2."
(declare (inline member))
(if (and testp notp)
(error "Test and test-not both supplied."))
(defun set-difference (list1 list2 &key key
(test #'eql testp) (test-not nil notp))
#!+sb-doc
- "Returns the elements of list1 which are not in list2."
+ "Return the elements of LIST1 which are not in LIST2."
(declare (inline member))
(if (and testp notp)
(error "Test and test-not both supplied."))
(defun nset-difference (list1 list2 &key key
(test #'eql testp) (test-not nil notp))
#!+sb-doc
- "Destructively returns the elements of list1 which are not in list2."
+ "Destructively return the elements of LIST1 which are not in LIST2."
(declare (inline member))
(if (and testp notp)
(error "Test and test-not both supplied."))
(defun set-exclusive-or (list1 list2 &key key
(test #'eql testp) (test-not nil notp))
#!+sb-doc
- "Returns new list of elements appearing exactly once in list1 and list2."
+ "Return new list of elements appearing exactly once in LIST1 and LIST2."
(declare (inline member))
(let ((result nil))
(dolist (elt list1)
(setq result (cons elt result))))
result))
-;;; The outer loop examines list1 while the inner loop examines list2. If an
-;;; element is found in list2 "equal" to the element in list1, both are
-;;; spliced out. When the end of list1 is reached, what is left of list2 is
-;;; tacked onto what is left of list1. The splicing operation ensures that
-;;; the correct operation is performed depending on whether splice is at the
-;;; top of the list or not
-
+;;; The outer loop examines list1 while the inner loop examines list2.
+;;; If an element is found in list2 "equal" to the element in list1,
+;;; both are spliced out. When the end of list1 is reached, what is
+;;; left of list2 is tacked onto what is left of list1. The splicing
+;;; operation ensures that the correct operation is performed
+;;; depending on whether splice is at the top of the list or not
(defun nset-exclusive-or (list1 list2 &key (test #'eql) (test-not nil notp)
key)
#!+sb-doc
- "Destructively return a list with elements which appear but once in list1
- and list2."
+ "Destructively return a list with elements which appear but once in LIST1
+ and LIST2."
(do ((list1 list1)
(list2 list2)
(x list1 (cdr x))
(defun subsetp (list1 list2 &key key (test #'eql testp) (test-not nil notp))
#!+sb-doc
- "Returns T if every element in list1 is also in list2."
+ "Return T if every element in LIST1 is also in LIST2."
(declare (inline member))
(dolist (elt list1)
(unless (with-set-keys (member (apply-key key elt) list2))
(defun acons (key datum alist)
#!+sb-doc
- "Construct a new alist by adding the pair (key . datum) to alist"
+ "Construct a new alist by adding the pair (KEY . DATUM) to ALIST."
(cons (cons key datum) alist))
(defun pairlis (keys data &optional (alist '()))
#!+sb-doc
- "Construct an association list from keys and data (adding to alist)"
+ "Construct an association list from KEYS and DATA (adding to ALIST)."
(do ((x keys (cdr x))
(y data (cdr y)))
((and (endp x) (endp y)) alist)
(defun assoc (item alist &key key test test-not)
#!+sb-doc
- "Returns the cons in ALIST whose car is equal (by a given test or EQL) to
+ "Return the cons in ALIST whose car is equal (by a given test or EQL) to
the ITEM."
;; FIXME: Shouldn't there be a check for existence of both TEST and TEST-NOT?
(cond (test
(defun assoc-if (predicate alist &key key)
#!+sb-doc
- "Returns the first cons in alist whose car satisfies the Predicate. If
+ "Return the first cons in alist whose car satisfies the Predicate. If
key is supplied, apply it to the car of each cons before testing."
(if key
(assoc-guts (funcall predicate (funcall key (caar alist))))
(defun assoc-if-not (predicate alist &key key)
#!+sb-doc
- "Returns the first cons in alist whose car does not satisfiy the Predicate.
- If key is supplied, apply it to the car of each cons before testing."
+ "Return the first cons in ALIST whose car does not satisfy the PREDICATE.
+ If KEY is supplied, apply it to the car of each cons before testing."
(if key
(assoc-guts (not (funcall predicate (funcall key (caar alist)))))
(assoc-guts (not (funcall predicate (caar alist))))))
(defun rassoc (item alist &key key test test-not)
(declare (list alist))
#!+sb-doc
- "Returns the cons in alist whose cdr is equal (by a given test or EQL) to
- the Item."
+ "Return the cons in ALIST whose cdr is equal (by a given test or EQL) to
+ the ITEM."
(cond (test
(if key
(assoc-guts (funcall test item (funcall key (cdar alist))))
(defun rassoc-if (predicate alist &key key)
#!+sb-doc
- "Returns the first cons in alist whose cdr satisfies the Predicate. If key
+ "Return the first cons in alist whose cdr satisfies the Predicate. If key
is supplied, apply it to the cdr of each cons before testing."
(if key
(assoc-guts (funcall predicate (funcall key (cdar alist))))
(defun rassoc-if-not (predicate alist &key key)
#!+sb-doc
- "Returns the first cons in alist whose cdr does not satisfy the Predicate.
+ "Return the first cons in alist whose cdr does not satisfy the Predicate.
If key is supplied, apply it to the cdr of each cons before testing."
(if key
(assoc-guts (not (funcall predicate (funcall key (cdar alist)))))