0.pre7.38:

[sbcl.git] / src / code / list.lisp

diff --git a/src/code/list.lisp b/src/code/list.lisp
index 4dea431..55f66c9 100644 (file)
--- a/src/code/list.lisp
+++ b/src/code/list.lisp
@@ -16,11 +16,10 @@
 ;;;; -- WHN 20000127
 
 (declaim (maybe-inline
 ;;;; -- 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
          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))
 
          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))
 

@@ -427,9 +426,9 @@
        list))))
 
 (defun ldiff (list object)
        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))
   (do* ((list list (cdr list))
        (result (list ()))
        (splice result))

@@ -445,12 +444,12 @@
 
 (defun rplaca (x y)
   #!+sb-doc
 
 (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
   (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.
   (rplacd x y))
 
 ;;; The following are for use by SETF.

@@ -459,10 +458,9 @@
 
 (defun %rplacd (x val) (rplacd x val) val)
 
 
 (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))
 (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)
   (do ((count n (1- count))
        (list list (cdr list)))
       ((endp list)

@@ -484,12 +482,12 @@
 
 (defun identity (thing)
   #!+sb-doc
 
 (defun identity (thing)
   #!+sb-doc

-  "Returns what was passed to it."
+  "This function simply returns what was passed to it."

   thing)
 
 (defun complement (function)
   #!+sb-doc
   thing)
 
 (defun complement (function)
   #!+sb-doc

-  "Builds a new function that returns T whenever FUNCTION returns NIL and
+  "Return a new function that returns T whenever FUNCTION returns NIL and

    NIL whenever FUNCTION returns non-NIL."
   (lambda (&optional (arg0 nil arg0-p) (arg1 nil arg1-p) (arg2 nil arg2-p)
                     &rest more-args)
    NIL whenever FUNCTION returns non-NIL."
   (lambda (&optional (arg0 nil arg0-p) (arg1 nil arg1-p) (arg2 nil arg2-p)
                     &rest more-args)

@@ -673,7 +671,7 @@
 (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,
 (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."
+   :TEST, or :TEST-NOT with a given item."

   (do ((list list (cdr list)))
       ((null list) nil)
     (let ((car (car list)))
   (do ((list list (cdr list)))
       ((null list) nil)
     (let ((car (car list)))

@@ -682,7 +680,7 @@
 
 (defun member-if (test list &key key)
   #!+sb-doc
 
 (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)))
   (do ((list list (Cdr list)))
       ((endp list) nil)
     (if (funcall test (apply-key key (car list)))

@@ -690,7 +688,7 @@
 
 (defun member-if-not (test list &key key)
   #!+sb-doc
 
 (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))))
   (do ((list list (cdr list)))
       ((endp list) ())
     (if (not (funcall test (apply-key key (car list))))

@@ -698,8 +696,8 @@
 
 (defun tailp (object list)
   #!+sb-doc
 
 (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)
   (do ((list list (cdr list)))
       ((atom list) (eql list object))
     (if (eql object list)

@@ -707,7 +705,7 @@
 
 (defun adjoin (item list &key key (test #'eql) (test-not nil notp))
   #!+sb-doc
 
 (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
   (declare (inline member))
   (if (let ((key-val (apply-key key item)))
        (if notp

@@ -722,7 +720,7 @@
 ;;; order.
 (defun union (list1 list2 &key key (test #'eql testp) (test-not nil notp))
   #!+sb-doc
 ;;; 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))
   (declare (inline member))
   (when (and testp notp) (error "Test and test-not both supplied."))
   (let ((res list2))

@@ -731,8 +729,8 @@
        (push elt res)))
     res))
 
        (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)
 ;;;
 ;;; FIXME: needs a more mnemonic name
 (defmacro steve-splice (source destination)

@@ -743,10 +741,10 @@
 
 (defun nunion (list1 list2 &key key (test #'eql testp) (test-not nil notp))
   #!+sb-doc
 
 (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)
   (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 ()
   (let ((res list2)
        (list1 list1))
     (do ()

@@ -759,7 +757,7 @@
 (defun intersection (list1 list2 &key key
                           (test #'eql testp) (test-not nil notp))
   #!+sb-doc
 (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."))
   (declare (inline member))
   (if (and testp notp)
       (error "Test and test-not both supplied."))

@@ -772,7 +770,7 @@
 (defun nintersection (list1 list2 &key key
                            (test #'eql testp) (test-not nil notp))
   #!+sb-doc
 (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."))
   (declare (inline member))
   (if (and testp notp)
       (error "Test and test-not both supplied."))

@@ -787,7 +785,7 @@
 (defun set-difference (list1 list2 &key key
                             (test #'eql testp) (test-not nil notp))
   #!+sb-doc
 (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."))
   (declare (inline member))
   (if (and testp notp)
       (error "Test and test-not both supplied."))

@@ -802,7 +800,7 @@
 (defun nset-difference (list1 list2 &key key
                              (test #'eql testp) (test-not nil notp))
   #!+sb-doc
 (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."))
   (declare (inline member))
   (if (and testp notp)
       (error "Test and test-not both supplied."))

@@ -817,7 +815,7 @@
 (defun set-exclusive-or (list1 list2 &key key
                               (test #'eql testp) (test-not nil notp))
   #!+sb-doc
 (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)
   (declare (inline member))
   (let ((result nil))
     (dolist (elt list1)

@@ -828,18 +826,17 @@
        (setq result (cons elt result))))
     result))
 
        (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
 (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))
   (do ((list1 list1)
        (list2 list2)
        (x list1 (cdr x))

@@ -868,7 +865,7 @@
 
 (defun subsetp (list1 list2 &key key (test #'eql testp) (test-not nil notp))
   #!+sb-doc
 
 (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))
   (declare (inline member))
   (dolist (elt list1)
     (unless (with-set-keys (member (apply-key key elt) list2))

@@ -879,12 +876,12 @@
 
 (defun acons (key datum alist)
   #!+sb-doc
 
 (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
   (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)
   (do ((x keys (cdr x))
        (y data (cdr y)))
       ((and (endp x) (endp y)) alist)

@@ -931,8 +928,8 @@
 
 (defun assoc-if-not (predicate alist &key key)
   #!+sb-doc
 
 (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."
+  "Returns 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))))))
   (if key
       (assoc-guts (not (funcall predicate (funcall key (caar alist)))))
       (assoc-guts (not (funcall predicate (caar alist))))))

@@ -940,8 +937,8 @@
 (defun rassoc (item alist &key key test test-not)
   (declare (list alist))
   #!+sb-doc
 (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."
+  "Returns 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))))
   (cond (test
         (if key
             (assoc-guts (funcall test item (funcall key (cdar alist))))