0.pre7.50:
[sbcl.git] / src / code / seq.lisp
index 98d616e..4d5b1ca 100644 (file)
 
 (sb!xc:defmacro make-sequence-like (sequence length)
   #!+sb-doc
-  "Returns a sequence of the same type as SEQUENCE and the given LENGTH."
+  "Return a sequence of the same type as SEQUENCE and the given LENGTH."
   `(make-sequence-of-type (type-of ,sequence) ,length))
 
 (sb!xc:defmacro type-specifier-atom (type)
-  #!+sb-doc "Returns the broad class of which TYPE is a specific subclass."
+  #!+sb-doc "Return the broad class of which TYPE is a specific subclass."
   `(if (atom ,type) ,type (car ,type)))
 
 ) ; EVAL-WHEN
                              '(integer (0) (0))))))
 
 (defun make-sequence-of-type (type length)
-  #!+sb-doc "Returns a sequence of the given TYPE and LENGTH."
+  #!+sb-doc "Return a sequence of the given TYPE and LENGTH."
   (declare (fixnum length))
   (case (type-specifier-atom type)
     (list (make-list length))
      (make-sequence-of-type (result-type-or-lose type) length))))
 \f
 (defun elt (sequence index)
-  #!+sb-doc "Returns the element of SEQUENCE specified by INDEX."
+  #!+sb-doc "Return the element of SEQUENCE specified by INDEX."
   (etypecase sequence
     (list
      (do ((count index (1- count))
 ;;; routines for other reasons (see above).
 (defun subseq (sequence start &optional end)
   #!+sb-doc
-  "Returns a copy of a subsequence of SEQUENCE starting with element number
+  "Return a copy of a subsequence of SEQUENCE starting with element number
    START and continuing to the end of SEQUENCE or the optional END."
   (seq-dispatch sequence
                (list-subseq* sequence start end)
 ) ; EVAL-WHEN
 
 (defun copy-seq (sequence)
-  #!+sb-doc "Returns a copy of SEQUENCE which is EQUAL to SEQUENCE but not EQ."
+  #!+sb-doc "Return a copy of SEQUENCE which is EQUAL to SEQUENCE but not EQ."
   (seq-dispatch sequence
                (list-copy-seq* sequence)
                (vector-copy-seq* sequence)))
 
 (defun reverse (sequence)
   #!+sb-doc
-  "Returns a new sequence containing the same elements but in reverse order."
+  "Return a new sequence containing the same elements but in reverse order."
   (seq-dispatch sequence
                (list-reverse* sequence)
                (vector-reverse* sequence)))
 
 (defun nreverse (sequence)
   #!+sb-doc
-  "Returns a sequence of the same elements in reverse order; the argument
+  "Return a sequence of the same elements in reverse order; the argument
    is destroyed."
   (seq-dispatch sequence
                (list-nreverse* sequence)
 ;;; efficiency, but space efficiency..)
 (defun concatenate (output-type-spec &rest sequences)
   #!+sb-doc
-  "Returns a new sequence of all the argument sequences concatenated together
+  "Return a new sequence of all the argument sequences concatenated together
   which shares no structure with the original argument sequences of the
   specified OUTPUT-TYPE-SPEC."
   (case (type-specifier-atom output-type-spec)
                              ,@more-seqs)
                         ,',unfound-result)))))))
   (defquantifier some when pred-value :unfound-result nil :doc
-  "PREDICATE is applied to the elements with index 0 of the sequences, then 
-   possibly to those with index 1, and so on. SOME returns the first 
-   non-NIL value encountered, or NIL if the end of a sequence is reached.")
+  "Apply PREDICATE to the 0-indexed elements of the sequences, then 
+   possibly to those with index 1, and so on. Return the first 
+   non-NIL value encountered, or NIL if the end of any sequence is reached.")
   (defquantifier every unless nil :doc
-  "PREDICATE is applied to the elements with index 0 of the sequences, then
-   possibly to those with index 1, and so on. EVERY returns NIL as soon
+  "Apply PREDICATE to the 0-indexed elements of the sequences, then
+   possibly to those with index 1, and so on. Return NIL as soon
    as any invocation of PREDICATE returns NIL, or T if every invocation
    is non-NIL.")
   (defquantifier notany when nil :doc
-  "PREDICATE is applied to the elements with index 0 of the sequences, then 
-   possibly to those with index 1, and so on. NOTANY returns NIL as soon
+  "Apply PREDICATE to the 0-indexed elements of the sequences, then 
+   possibly to those with index 1, and so on. Return NIL as soon
    as any invocation of PREDICATE returns a non-NIL value, or T if the end
-   of a sequence is reached.")
+   of any sequence is reached.")
   (defquantifier notevery unless t :doc
-  "PREDICATE is applied to the elements with index 0 of the sequences, then
-   possibly to those with index 1, and so on. NOTEVERY returns T as soon
+  "Apply PREDICATE to 0-indexed elements of the sequences, then
+   possibly to those with index 1, and so on. Return T as soon
    as any invocation of PREDICATE returns NIL, or NIL if every invocation
    is non-NIL."))
 \f
 (defun delete (item sequence &key from-end (test #'eql) test-not (start 0)
                end count key)
   #!+sb-doc
-  "Returns a sequence formed by destructively removing the specified Item from
-  the given Sequence."
+  "Return a sequence formed by destructively removing the specified ITEM from
+  the given SEQUENCE."
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))
 
 (defun delete-if (predicate sequence &key from-end (start 0) key end count)
   #!+sb-doc
-  "Returns a sequence formed by destructively removing the elements satisfying
-  the specified Predicate from the given Sequence."
+  "Return a sequence formed by destructively removing the elements satisfying
+  the specified PREDICATE from the given SEQUENCE."
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))
 
 (defun delete-if-not (predicate sequence &key from-end (start 0) end key count)
   #!+sb-doc
-  "Returns a sequence formed by destructively removing the elements not
-  satisfying the specified Predicate from the given Sequence."
+  "Return a sequence formed by destructively removing the elements not
+  satisfying the specified PREDICATE from the given SEQUENCE."
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))
 (defun remove (item sequence &key from-end (test #'eql) test-not (start 0)
                end count key)
   #!+sb-doc
-  "Returns a copy of SEQUENCE with elements satisfying the test (default is
+  "Return a copy of SEQUENCE with elements satisfying the test (default is
    EQL) with ITEM removed."
   (declare (fixnum start))
   (let* ((length (length sequence))
 
 (defun remove-if (predicate sequence &key from-end (start 0) end count key)
   #!+sb-doc
-  "Returns a copy of sequence with elements such that predicate(element)
-   is non-null are removed"
+  "Return a copy of sequence with elements such that predicate(element)
+   is non-null removed"
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))
 
 (defun remove-if-not (predicate sequence &key from-end (start 0) end count key)
   #!+sb-doc
-  "Returns a copy of sequence with elements such that predicate(element)
-   is null are removed"
+  "Return a copy of sequence with elements such that predicate(element)
+   is null removed"
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))
 (defun substitute (new old sequence &key from-end (test #'eql) test-not
                   (start 0) count end key)
   #!+sb-doc
-  "Returns a sequence of the same kind as Sequence with the same elements
-  except that all elements equal to Old are replaced with New. See manual
+  "Return a sequence of the same kind as SEQUENCE with the same elements,
+  except that all elements equal to OLD are replaced with NEW. See manual
   for details."
   (declare (fixnum start))
   (let* ((length (length sequence))
 
 (defun substitute-if (new test sequence &key from-end (start 0) end count key)
   #!+sb-doc
-  "Returns a sequence of the same kind as Sequence with the same elements
-  except that all elements satisfying the Test are replaced with New. See
+  "Return a sequence of the same kind as SEQUENCE with the same elements
+  except that all elements satisfying the TEST are replaced with NEW. See
   manual for details."
   (declare (fixnum start))
   (let* ((length (length sequence))
 (defun substitute-if-not (new test sequence &key from-end (start 0)
                           end count key)
   #!+sb-doc
-  "Returns a sequence of the same kind as Sequence with the same elements
-  except that all elements not satisfying the Test are replaced with New.
+  "Return a sequence of the same kind as SEQUENCE with the same elements
+  except that all elements not satisfying the TEST are replaced with NEW.
   See manual for details."
   (declare (fixnum start))
   (let* ((length (length sequence))
 (defun nsubstitute (new old sequence &key from-end (test #'eql) test-not
                     end count key (start 0))
   #!+sb-doc
-  "Returns a sequence of the same kind as Sequence with the same elements
-  except that all elements equal to Old are replaced with New. The Sequence
-  may be destroyed. See manual for details."
+  "Return a sequence of the same kind as SEQUENCE with the same elements
+  except that all elements equal to OLD are replaced with NEW. The SEQUENCE
+  may be destructively modified. See manual for details."
   (declare (fixnum start))
   (let ((end (or end (length sequence)))
        (count (or count most-positive-fixnum)))
 
 (defun nsubstitute-if (new test sequence &key from-end (start 0) end count key)
   #!+sb-doc
-  "Returns a sequence of the same kind as Sequence with the same elements
-   except that all elements satisfying the Test are replaced with New. The
-   Sequence may be destroyed. See manual for details."
+  "Return a sequence of the same kind as SEQUENCE with the same elements
+   except that all elements satisfying the TEST are replaced with NEW. 
+   SEQUENCE may be destructively modified. See manual for details."
   (declare (fixnum start))
   (let ((end (or end (length sequence)))
        (count (or count most-positive-fixnum)))
 (defun nsubstitute-if-not (new test sequence &key from-end (start 0)
                               end count key)
   #!+sb-doc
-  "Returns a sequence of the same kind as Sequence with the same elements
-   except that all elements not satisfying the Test are replaced with New.
-   The Sequence may be destroyed. See manual for details."
+  "Return a sequence of the same kind as SEQUENCE with the same elements
+   except that all elements not satisfying the TEST are replaced with NEW.
+   SEQUENCE may be destructively modified. See manual for details."
   (declare (fixnum start))
   (let ((end (or end (length sequence)))
        (count (or count most-positive-fixnum)))
       (setf (aref sequence index) new)
       (setq count (1- count)))))
 \f
-
-;;; REMOVEME: old POSITION/FIND stuff
-
-#|
-
-;;;; locater macros used by FIND and POSITION
-
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro vector-locater-macro (sequence body-form return-type)
-  `(let ((incrementer (if from-end -1 1))
-        (start (if from-end (1- (the fixnum end)) start))
-        (end (if from-end (1- (the fixnum start)) end)))
-     (declare (fixnum start end incrementer))
-     (do ((index start (+ index incrementer))
-         ,@(case return-type (:position nil) (:element '(current))))
-        ((= index end) ())
-       (declare (fixnum index))
-       ,@(case return-type
-          (:position nil)
-          (:element `((setf current (aref ,sequence index)))))
-       ,body-form)))
-
-(sb!xc:defmacro locater-test-not (item sequence seq-type return-type)
-  (let ((seq-ref (case return-type
-                  (:position
-                   (case seq-type
-                     (:vector `(aref ,sequence index))
-                     (:list `(pop ,sequence))))
-                  (:element 'current)))
-       (return (case return-type
-                 (:position 'index)
-                 (:element 'current))))
-    `(if test-not
-        (if (not (funcall test-not ,item (apply-key key ,seq-ref)))
-            (return ,return))
-        (if (funcall test ,item (apply-key key ,seq-ref))
-            (return ,return)))))
-
-(sb!xc:defmacro vector-locater (item sequence return-type)
-  `(vector-locater-macro ,sequence
-                        (locater-test-not ,item ,sequence :vector ,return-type)
-                        ,return-type))
-
-(sb!xc:defmacro locater-if-test (test sequence seq-type return-type sense)
-  (let ((seq-ref (case return-type
-                  (:position
-                   (case seq-type
-                     (:vector `(aref ,sequence index))
-                     (:list `(pop ,sequence))))
-                  (:element 'current)))
-       (return (case return-type
-                 (:position 'index)
-                 (:element 'current))))
-    (if sense
-       `(if (funcall ,test (apply-key key ,seq-ref))
-            (return ,return))
-       `(if (not (funcall ,test (apply-key key ,seq-ref)))
-            (return ,return)))))
-
-(sb!xc:defmacro vector-locater-if-macro (test sequence return-type sense)
-  `(vector-locater-macro ,sequence
-                        (locater-if-test ,test ,sequence :vector ,return-type ,sense)
-                        ,return-type))
-
-(sb!xc:defmacro vector-locater-if (test sequence return-type)
-  `(vector-locater-if-macro ,test ,sequence ,return-type t))
-
-(sb!xc:defmacro vector-locater-if-not (test sequence return-type)
-  `(vector-locater-if-macro ,test ,sequence ,return-type nil))
-
-(sb!xc:defmacro list-locater-macro (sequence body-form return-type)
-  `(if from-end
-       (do ((sequence (nthcdr (- (the fixnum (length sequence))
-                                (the fixnum end))
-                             (reverse (the list ,sequence))))
-           (index (1- (the fixnum end)) (1- index))
-           (terminus (1- (the fixnum start)))
-           ,@(case return-type (:position nil) (:element '(current))))
-          ((or (= index terminus) (null sequence)) ())
-        (declare (fixnum index terminus))
-        ,@(case return-type
-            (:position nil)
-            (:element `((setf current (pop ,sequence)))))
-        ,body-form)
-       (do ((sequence (nthcdr start ,sequence))
-           (index start (1+ index))
-           ,@(case return-type (:position nil) (:element '(current))))
-          ((or (= index (the fixnum end)) (null sequence)) ())
-        (declare (fixnum index))
-        ,@(case return-type
-            (:position nil)
-            (:element `((setf current (pop ,sequence)))))
-        ,body-form)))
-
-(sb!xc:defmacro list-locater (item sequence return-type)
-  `(list-locater-macro ,sequence
-                      (locater-test-not ,item ,sequence :list ,return-type)
-                      ,return-type))
-
-(sb!xc:defmacro list-locater-if-macro (test sequence return-type sense)
-  `(list-locater-macro ,sequence
-                      (locater-if-test ,test ,sequence :list ,return-type ,sense)
-                      ,return-type))
-
-(sb!xc:defmacro list-locater-if (test sequence return-type)
-  `(list-locater-if-macro ,test ,sequence ,return-type t))
-
-(sb!xc:defmacro list-locater-if-not (test sequence return-type)
-  `(list-locater-if-macro ,test ,sequence ,return-type nil))
-
-) ; EVAL-WHEN
-\f
-;;;; POSITION
-
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro vector-position (item sequence)
-  `(vector-locater ,item ,sequence :position))
-
-(sb!xc:defmacro list-position (item sequence)
-  `(list-locater ,item ,sequence :position))
-
-) ; EVAL-WHEN
-
-;;; POSITION cannot default end to the length of sequence since it is not
-;;; an error to supply nil for its value. We must test for END being NIL
-;;; in the body of the function, and this is actually done in the support
-;;; routines for other reasons (see below).
-(defun position (item sequence &key from-end (test #'eql) test-not (start 0)
-                 end key)
-  #!+sb-doc
-  "Returns the zero-origin index of the first element in SEQUENCE
-   satisfying the test (default is EQL) with the given ITEM"
-  (seq-dispatch sequence
-    (list-position* item sequence from-end test test-not start end key)
-    (vector-position* item sequence from-end test test-not start end key)))
-
-;;; The support routines for SUBSEQ are used by compiler transforms, so we
-;;; worry about dealing with END being supplied or defaulting to NIL
-;;; at this level.
-
-(defun list-position* (item sequence from-end test test-not start end key)
-  (declare (fixnum start))
-  (when (null end) (setf end (length sequence)))
-  (list-position item sequence))
-
-(defun vector-position* (item sequence from-end test test-not start end key)
-  (declare (fixnum start))
-  (when (null end) (setf end (length sequence)))
-  (vector-position item sequence))
-\f
-;;;; POSITION-IF
-
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro vector-position-if (test sequence)
-  `(vector-locater-if ,test ,sequence :position))
-
-(sb!xc:defmacro list-position-if (test sequence)
-  `(list-locater-if ,test ,sequence :position))
-
-) ; EVAL-WHEN
-
-(defun position-if (test sequence &key from-end (start 0) key end)
-  #!+sb-doc
-  "Returns the zero-origin index of the first element satisfying test(el)"
-  (declare (fixnum start))
-  (let ((end (or end (length sequence))))
-    (declare (type index end))
-    (seq-dispatch sequence
-                 (list-position-if test sequence)
-                 (vector-position-if test sequence))))
-\f
-;;;; POSITION-IF-NOT
-
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro vector-position-if-not (test sequence)
-  `(vector-locater-if-not ,test ,sequence :position))
-
-(sb!xc:defmacro list-position-if-not (test sequence)
-  `(list-locater-if-not ,test ,sequence :position))
-
-) ; EVAL-WHEN
-
-(defun position-if-not (test sequence &key from-end (start 0) key end)
-  #!+sb-doc
-  "Returns the zero-origin index of the first element not satisfying test(el)"
-  (declare (fixnum start))
-  (let ((end (or end (length sequence))))
-    (declare (type index end))
-    (seq-dispatch sequence
-                 (list-position-if-not test sequence)
-                 (vector-position-if-not test sequence))))
-\f
-;;;; FIND
-
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro vector-find (item sequence)
-  `(vector-locater ,item ,sequence :element))
-
-(sb!xc:defmacro list-find (item sequence)
-  `(list-locater ,item ,sequence :element))
-
-) ; EVAL-WHEN
-
-;;; Note: FIND cannot default end to the length of sequence since it
-;;; is not an error to supply NIL for its value. We must test for end
-;;; being NIL in the body of the function, and this is actually done
-;;; in the support routines for other reasons (see above).
-(defun find (item sequence &key from-end (test #'eql) test-not (start 0)
-                 end key)
-  #!+sb-doc
-  "Returns the first element in SEQUENCE satisfying the test (default
-   is EQL) with the given ITEM"
-  (declare (fixnum start))
-  (seq-dispatch sequence
-    (list-find* item sequence from-end test test-not start end key)
-    (vector-find* item sequence from-end test test-not start end key)))
-
-;;; The support routines for FIND are used by compiler transforms, so we
-;;; worry about dealing with END being supplied or defaulting to NIL
-;;; at this level.
-
-(defun list-find* (item sequence from-end test test-not start end key)
-  (when (null end) (setf end (length sequence)))
-  (list-find item sequence))
-
-(defun vector-find* (item sequence from-end test test-not start end key)
-  (when (null end) (setf end (length sequence)))
-  (vector-find item sequence))
-\f
-;;;; FIND-IF and FIND-IF-NOT
-
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro vector-find-if (test sequence)
-  `(vector-locater-if ,test ,sequence :element))
-
-(sb!xc:defmacro list-find-if (test sequence)
-  `(list-locater-if ,test ,sequence :element))
-
-) ; EVAL-WHEN
-
-(defun find-if (test sequence &key from-end (start 0) end key)
-  #!+sb-doc
-  "Returns the zero-origin index of the first element satisfying the test."
-  (declare (fixnum start))
-  (let ((end (or end (length sequence))))
-    (declare (type index end))
-    (seq-dispatch sequence
-                 (list-find-if test sequence)
-                 (vector-find-if test sequence))))
-
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro vector-find-if-not (test sequence)
-  `(vector-locater-if-not ,test ,sequence :element))
-
-(sb!xc:defmacro list-find-if-not (test sequence)
-  `(list-locater-if-not ,test ,sequence :element))
-
-) ; EVAL-WHEN
-
-(defun find-if-not (test sequence &key from-end (start 0) end key)
-  #!+sb-doc
-  "Returns the zero-origin index of the first element not satisfying the test."
-  (declare (fixnum start))
-  (let ((end (or end (length sequence))))
-    (declare (type index end))
-    (seq-dispatch sequence
-                 (list-find-if-not test sequence)
-                 (vector-find-if-not test sequence))))
-|#
-\f
 ;;;; FIND, POSITION, and their -IF and -IF-NOT variants
 
 ;;; logic to unravel :TEST, :TEST-NOT, and :KEY options in FIND,
                                                  from-end start end key)))
       (frobs))))
 
-;;; the user interface to FIND and POSITION: Get all our ducks in a row,
-;;; then call %FIND-POSITION
+;;; the user interface to FIND and POSITION: Get all our ducks in a
+;;; row, then call %FIND-POSITION.
 (declaim (inline find position))
 (macrolet ((def-find-position (fun-name values-index)
             `(defun ,fun-name (item
 ;;; the deprecated functions FIND-IF-NOT and POSITION-IF-NOT. We don't
 ;;; bother to worry about optimizing them.
 ;;;
+;;; (Except note that on Sat, Oct 06, 2001 at 04:22:38PM +0100,
+;;; Christophe Rhodes wrote on sbcl-devel
+;;;
+;;;     My understanding is that while the :test-not argument is
+;;;     deprecated in favour of :test (complement #'foo) because of
+;;;     semantic difficulties (what happens if both :test and :test-not
+;;;     are supplied, etc) the -if-not variants, while officially
+;;;     deprecated, would be undeprecated were X3J13 actually to produce
+;;;     a revised standard, as there are perfectly legitimate idiomatic
+;;;     reasons for allowing the -if-not versions equal status,
+;;;     particularly remove-if-not (== filter).
+;;;   
+;;;     This is only an informal understanding, I grant you, but
+;;;     perhaps it's worth optimizing the -if-not versions in the same
+;;;     way as the others?
+;;;
+;;; That sounds reasonable, so if someone wants to submit patches to
+;;; make the -IF-NOT functions compile as efficiently as the
+;;; corresponding -IF variants do, go for it. -- WHN 2001-10-06)
+;;;
 ;;; FIXME: Remove uses of these deprecated functions (and of :TEST-NOT
 ;;; too) within the implementation of SBCL.
 (macrolet ((def-find-position-if-not (fun-name values-index)
 (defun count (item sequence &key from-end (test #'eql) test-not (start 0)
                end key)
   #!+sb-doc
-  "Returns the number of elements in SEQUENCE satisfying a test with ITEM,
+  "Return the number of elements in SEQUENCE satisfying a test with ITEM,
    which defaults to EQL."
   (declare (ignore from-end) (fixnum start))
   (let ((end (or end (length sequence))))
 
 (defun count-if (test sequence &key from-end (start 0) end key)
   #!+sb-doc
-  "Returns the number of elements in SEQUENCE satisfying TEST(el)."
+  "Return the number of elements in SEQUENCE satisfying TEST(el)."
   (declare (ignore from-end) (fixnum start))
   (let ((end (or end (length sequence))))
     (declare (type index end))
 
 (defun count-if-not (test sequence &key from-end (start 0) end key)
   #!+sb-doc
-  "Returns the number of elements in SEQUENCE not satisfying TEST(el)."
+  "Return the number of elements in SEQUENCE not satisfying TEST(el)."
   (declare (ignore from-end) (fixnum start))
   (let ((end (or end (length sequence))))
     (declare (type index end))