0.7.9.29:

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

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 52c28e8..fe09338 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -17,73 +17,104 @@
 ;;;; files for more information.
 
 (in-package "SB!IMPL")
 ;;;; files for more information.
 
 (in-package "SB!IMPL")

-
-(file-comment
-  "$Header$")

 \f
 ;;;; utilities
 
 (eval-when (:compile-toplevel)
 
 \f
 ;;;; utilities
 
 (eval-when (:compile-toplevel)
 

-;;; Seq-Dispatch does an efficient type-dispatch on the given Sequence.
-
-;;; FIXME: It might be worth making three cases here, LIST, SIMPLE-VECTOR,
-;;; and VECTOR, instead of the current LIST and VECTOR. It tend to make code
-;;; run faster but be bigger; some benchmarking is needed to decide.
+;;; SEQ-DISPATCH does an efficient type-dispatch on the given SEQUENCE.
+;;;
+;;; FIXME: It might be worth making three cases here, LIST,
+;;; SIMPLE-VECTOR, and VECTOR, instead of the current LIST and VECTOR.
+;;; It tends to make code run faster but be bigger; some benchmarking
+;;; is needed to decide.

 (sb!xc:defmacro seq-dispatch (sequence list-form array-form)
   `(if (listp ,sequence)
        ,list-form
        ,array-form))
 
 (sb!xc:defmacro seq-dispatch (sequence list-form array-form)
   `(if (listp ,sequence)
        ,list-form
        ,array-form))
 

-;;; FIXME: Implementations of MAPFOO which use this are O(N*N) when users
-;;; could reasonably expect them to be O(N). This should be fixed.
-(sb!xc:defmacro elt-slice (sequences n)
-  #!+sb-doc
-  "Returns a list of the Nth element of each of the sequences. Used by MAP
-   and friends."
-  `(mapcar #'(lambda (seq) (elt seq ,n)) ,sequences))
-

 (sb!xc:defmacro make-sequence-like (sequence length)
   #!+sb-doc
 (sb!xc:defmacro make-sequence-like (sequence length)
   #!+sb-doc

-  "Returns 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."
-  `(if (atom ,type) ,type (car ,type)))
-
+  "Return a sequence of the same type as SEQUENCE and the given LENGTH."
+  `(if (typep ,sequence 'list)
+       (make-list ,length)
+       (progn
+        ;; This is only called from places which have already deduced
+        ;; that the SEQUENCE argument is actually a sequence.  So
+        ;; this would be a candidate place for (AVER (TYPEP ,SEQUENCE
+        ;; 'VECTOR)), except that this seems to be a performance
+        ;; hotspot.
+        (make-array ,length
+                    :element-type (array-element-type ,sequence)))))
+
+(sb!xc:defmacro bad-sequence-type-error (type-spec)
+  `(error 'simple-type-error
+          :datum ,type-spec
+          ;; FIXME: This is actually wrong, and should be something
+          ;; like (SATISFIES IS-A-VALID-SEQUENCE-TYPE-SPECIFIER-P).
+          :expected-type 'sequence
+          :format-control "~S is a bad type specifier for sequences."
+          :format-arguments (list ,type-spec)))
+
+(sb!xc:defmacro sequence-type-length-mismatch-error (type length)
+  `(error 'simple-type-error
+          :datum ,length
+          :expected-type (cond ((array-type-p ,type)
+                               `(eql ,(car (array-type-dimensions ,type))))
+                              ((type= ,type (specifier-type 'null))
+                               '(eql 0))
+                              ((cons-type-p ,type)
+                               '(integer 1))
+                              (t (bug "weird type in S-T-L-M-ERROR")))
+          ;; FIXME: this format control causes ugly printing.  There's
+          ;; probably some ~<~@:_~> incantation that would make it
+          ;; nicer. -- CSR, 2002-10-18
+          :format-control "The length requested (~S) does not match the type restriction in ~S."
+          :format-arguments (list ,length (type-specifier ,type))))
+
+(sb!xc:defmacro sequence-type-too-hairy (type-spec)
+  ;; FIXME: Should this be a BUG? I'm inclined to think not; there are
+  ;; words that give some but not total support to this position in
+  ;; ANSI.  Essentially, we are justified in throwing this on
+  ;; e.g. '(OR SIMPLE-VECTOR (VECTOR FIXNUM)), but maybe not (by ANSI)
+  ;; on '(CONS * (CONS * NULL)) -- CSR, 2002-10-18
+  `(error 'simple-type-error
+          :datum ,type-spec
+          ;; FIXME: as in BAD-SEQUENCE-TYPE-ERROR, this is wrong.
+          :expected-type 'sequence
+          :format-control "~S is too hairy for sequence functions."
+          :format-arguments (list ,type-spec)))

 ) ; EVAL-WHEN
 
 ) ; EVAL-WHEN
 

-;;; Given an arbitrary type specifier, return a sane sequence type
-;;; specifier that we can directly match.
-(defun result-type-or-lose (type &optional nil-ok)
-  (let ((type (specifier-type type)))
-    (cond
-      ((eq type *empty-type*)
-       (if nil-ok
-          nil
-          (error 'simple-type-error
-                 :datum type
-                 :expected-type '(or vector cons)
-                 :format-control
-                 "NIL output type invalid for this sequence function."
-                 :format-arguments ())))
-      ((dolist (seq-type '(list string simple-vector bit-vector))
-        (when (csubtypep type (specifier-type seq-type))
-          (return seq-type))))
-      ((csubtypep type (specifier-type 'vector))
-       (type-specifier type))
-      (t
-       (error 'simple-type-error
-             :datum type
-             :expected-type 'sequence
-             :format-control
-             "~S is a bad type specifier for sequence functions."
-             :format-arguments (list type))))))
+;;; It's possible with some sequence operations to declare the length
+;;; of a result vector, and to be safe, we really ought to verify that
+;;; the actual result has the declared length.
+(defun vector-of-checked-length-given-length (vector declared-length)
+  (declare (type vector vector))
+  (declare (type index declared-length))
+  (let ((actual-length (length vector)))
+    (unless (= actual-length declared-length)
+      (error 'simple-type-error
+            :datum vector
+            :expected-type `(vector ,declared-length)
+            :format-control
+            "Vector length (~W) doesn't match declared length (~W)."
+            :format-arguments (list actual-length declared-length))))
+  vector)
+(defun sequence-of-checked-length-given-type (sequence result-type)
+  (let ((ctype (specifier-type result-type)))
+    (if (not (array-type-p ctype))
+       sequence
+       (let ((declared-length (first (array-type-dimensions ctype))))
+         (if (eq declared-length '*)
+             sequence
+             (vector-of-checked-length-given-length sequence
+                                                    declared-length))))))

 
 (defun signal-index-too-large-error (sequence index)
   (let* ((length (length sequence))
 
 (defun signal-index-too-large-error (sequence index)
   (let* ((length (length sequence))

-        (max-index (and (plusp length)(1- length))))
+        (max-index (and (plusp length)
+                        (1- length))))

     (error 'index-too-large-error
           :datum index
           :expected-type (if max-index
     (error 'index-too-large-error
           :datum index
           :expected-type (if max-index

@@ -91,24 +122,27 @@
                              ;; This seems silly, is there something better?
                              '(integer (0) (0))))))
 
                              ;; This seems silly, is there something better?
                              '(integer (0) (0))))))
 

-(defun make-sequence-of-type (type length)
-  #!+sb-doc "Returns a sequence of the given TYPE and LENGTH."
-  (declare (fixnum length))
-  (case (type-specifier-atom type)
-    (list (make-list length))
-    ((bit-vector simple-bit-vector) (make-array length :element-type '(mod 2)))
-    ((string simple-string base-string simple-base-string)
-     (make-string length))
-    (simple-vector (make-array length))
-    ((array simple-array vector)
-     (if (listp type)
-        (make-array length :element-type (cadr type))
-        (make-array length)))
-    (t
-     (make-sequence-of-type (result-type-or-lose type) length))))
+(defun signal-end-too-large-error (sequence end)
+  (let* ((length (length sequence))
+        (max-end (and (not (minusp length))
+                      length)))
+    (error 'end-too-large-error
+          :datum end
+          :expected-type (if max-end
+                             `(integer 0 ,max-end)
+                             ;; This seems silly, is there something better?
+                             '(integer (0) 0)))))
+
+(declaim (inline adjust-count)
+         (ftype (function (sequence-count) index) adjust-count))
+(defun adjust-count (count)
+  (cond ((not count) most-positive-fixnum)
+        ((< count 0) 0)
+        (t count)))
+

 \f
 (defun elt (sequence index)
 \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))
   (etypecase sequence
     (list
      (do ((count index (1- count))

@@ -140,72 +174,86 @@
      (setf (aref sequence index) newval))))
 
 (defun length (sequence)
      (setf (aref sequence index) newval))))
 
 (defun length (sequence)

-  #!+sb-doc "Returns an integer that is the length of SEQUENCE."
+  #!+sb-doc "Return an integer that is the length of SEQUENCE."

   (etypecase sequence
     (vector (length (truly-the vector sequence)))
     (list (length (truly-the list sequence)))))
 
 (defun make-sequence (type length &key (initial-element NIL iep))
   #!+sb-doc
   (etypecase sequence
     (vector (length (truly-the vector sequence)))
     (list (length (truly-the list sequence)))))
 
 (defun make-sequence (type length &key (initial-element NIL iep))
   #!+sb-doc

-  "Returns a sequence of the given Type and Length, with elements initialized
-  to :Initial-Element."
+  "Return a sequence of the given TYPE and LENGTH, with elements initialized
+  to :INITIAL-ELEMENT."

   (declare (fixnum length))
   (let ((type (specifier-type type)))
     (cond ((csubtypep type (specifier-type 'list))
   (declare (fixnum length))
   (let ((type (specifier-type type)))
     (cond ((csubtypep type (specifier-type 'list))

-          (make-list length :initial-element initial-element))
-         ((csubtypep type (specifier-type 'string))
-          (if iep
-              (make-string length :initial-element initial-element)
-              (make-string length)))
-         ((csubtypep type (specifier-type 'simple-vector))
-          (make-array length :initial-element initial-element))
-         ((csubtypep type (specifier-type 'bit-vector))
-          (if iep
-              (make-array length :element-type '(mod 2)
-                          :initial-element initial-element)
-              (make-array length :element-type '(mod 2))))
+          (cond
+            ((type= type (specifier-type 'list))
+             (make-list length :initial-element initial-element))
+            ((eq type *empty-type*)
+             (bad-sequence-type-error nil))
+            ((type= type (specifier-type 'null))
+             (if (= length 0)
+                 'nil
+                 (sequence-type-length-mismatch-error type length)))
+            ((csubtypep (specifier-type '(cons nil t)) type)
+             ;; The above is quite a neat way of finding out if
+             ;; there's a type restriction on the CDR of the
+             ;; CONS... if there is, I think it's probably fair to
+             ;; give up; if there isn't, then the list to be made
+             ;; must have a length of more than 0.
+             (if (> length 0)
+                 (make-list length :initial-element initial-element)
+                 (sequence-type-length-mismatch-error type length)))
+            ;; We'll get here for e.g. (OR NULL (CONS INTEGER *)),
+            ;; which may seem strange and non-ideal, but then I'd say
+            ;; it was stranger to feed that type in to MAKE-SEQUENCE.
+            (t (sequence-type-too-hairy (type-specifier type)))))

          ((csubtypep type (specifier-type 'vector))
           (if (typep type 'array-type)
          ((csubtypep type (specifier-type 'vector))
           (if (typep type 'array-type)

-              (let ((etype (type-specifier
-                            (array-type-specialized-element-type type)))
-                    (vlen (car (array-type-dimensions type))))
-                (if (and (numberp vlen) (/= vlen length))
-                  (error 'simple-type-error
-                         ;; these two are under-specified by ANSI
-                         :datum (type-specifier type)
-                         :expected-type (type-specifier type)
-                         :format-control
-                         "The length of ~S does not match the specified length  of ~S."
-                         :format-arguments
-                         (list (type-specifier type) length)))
-                (if iep
-                    (make-array length :element-type etype
-                                :initial-element initial-element)
-                    (make-array length :element-type etype)))
-              (make-array length :initial-element initial-element)))
-         (t (error 'simple-type-error
-                   :datum type
-                   :expected-type 'sequence
-                   :format-control "~S is a bad type specifier for sequences."
-                   :format-arguments (list type))))))
+              ;; KLUDGE: the above test essentially asks "Do we know
+              ;; what the upgraded-array-element-type is?" [consider
+              ;; (OR STRING BIT-VECTOR)]
+              (progn
+                (aver (= (length (array-type-dimensions type)) 1))
+                (let ((etype (type-specifier
+                              (array-type-specialized-element-type type)))
+                      (type-length (car (array-type-dimensions type))))
+                  (unless (or (eq type-length '*)
+                              (= type-length length))
+                    (sequence-type-length-mismatch-error type length))
+                  ;; FIXME: These calls to MAKE-ARRAY can't be
+                  ;; open-coded, as the :ELEMENT-TYPE argument isn't
+                  ;; constant.  Probably we ought to write a
+                  ;; DEFTRANSFORM for MAKE-SEQUENCE.  -- CSR,
+                  ;; 2002-07-22
+                  (if iep
+                      (make-array length :element-type etype
+                                  :initial-element initial-element)
+                      (make-array length :element-type etype))))
+              (sequence-type-too-hairy (type-specifier type))))
+         (t (bad-sequence-type-error (type-specifier type))))))

 \f
 ;;;; SUBSEQ
 ;;;;
 \f
 ;;;; SUBSEQ
 ;;;;

-;;;; 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.
+;;;; 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 vector-subseq* (sequence start &optional end)
   (declare (type vector sequence))
   (declare (type fixnum start))
   (declare (type (or null fixnum) end))
 
 (defun vector-subseq* (sequence start &optional end)
   (declare (type vector sequence))
   (declare (type fixnum start))
   (declare (type (or null fixnum) end))

-  (when (null end) (setf end (length sequence)))
+  (if (null end)
+      (setf end (length sequence))
+      (unless (<= end (length sequence))
+       (signal-end-too-large-error sequence end)))

   (do ((old-index start (1+ old-index))
        (new-index 0 (1+ new-index))
        (copy (make-sequence-like sequence (- end start))))
       ((= old-index end) copy)
     (declare (fixnum old-index new-index))
   (do ((old-index start (1+ old-index))
        (new-index 0 (1+ new-index))
        (copy (make-sequence-like sequence (- end start))))
       ((= old-index end) copy)
     (declare (fixnum old-index new-index))

-    (setf (aref copy new-index) (aref sequence old-index))))
+    (setf (aref copy new-index)
+         (aref sequence old-index))))

 
 (defun list-subseq* (sequence start &optional end)
   (declare (type list sequence))
 
 (defun list-subseq* (sequence start &optional end)
   (declare (type list sequence))

@@ -224,13 +272,13 @@
              (declare (fixnum index)))
            ()))))
 
              (declare (fixnum index)))
            ()))))
 

-;;; SUBSEQ 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).
+;;; SUBSEQ 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 subseq (sequence start &optional end)
   #!+sb-doc
 (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)
    START and continuing to the end of SEQUENCE or the optional END."
   (seq-dispatch sequence
                (list-subseq* sequence start end)

@@ -240,11 +288,11 @@
 
 (eval-when (:compile-toplevel :execute)
 
 
 (eval-when (:compile-toplevel :execute)
 

-(sb!xc:defmacro vector-copy-seq (sequence type)
+(sb!xc:defmacro vector-copy-seq (sequence)

   `(let ((length (length (the vector ,sequence))))
      (declare (fixnum length))
      (do ((index 0 (1+ index))
   `(let ((length (length (the vector ,sequence))))
      (declare (fixnum length))
      (do ((index 0 (1+ index))

-         (copy (make-sequence-of-type ,type length)))
+         (copy (make-sequence-like ,sequence length)))

         ((= index length) copy)
        (declare (fixnum index))
        (setf (aref copy index) (aref ,sequence index)))))
         ((= index length) copy)
        (declare (fixnum index))
        (setf (aref copy index) (aref ,sequence index)))))

@@ -262,7 +310,7 @@
 ) ; EVAL-WHEN
 
 (defun copy-seq (sequence)
 ) ; 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)))
   (seq-dispatch sequence
                (list-copy-seq* sequence)
                (vector-copy-seq* sequence)))

@@ -273,7 +321,8 @@
   (list-copy-seq sequence))
 
 (defun vector-copy-seq* (sequence)
   (list-copy-seq sequence))
 
 (defun vector-copy-seq* (sequence)

-  (vector-copy-seq sequence (type-of sequence)))
+  (declare (type vector sequence))
+  (vector-copy-seq sequence))

 \f
 ;;;; FILL
 
 \f
 ;;;; FILL
 

@@ -426,9 +475,9 @@
   (when (null source-end) (setq source-end (length source-sequence)))
   (mumble-replace-from-mumble))
 
   (when (null source-end) (setq source-end (length source-sequence)))
   (mumble-replace-from-mumble))
 

-;;; REPLACE cannot default end arguments to the length of sequence since it
-;;; is not an error to supply nil for their values. We must test for ends
-;;; being nil in the body of the function.
+;;; REPLACE cannot default END arguments to the length of SEQUENCE since it
+;;; is not an error to supply NIL for their values. We must test for ENDs
+;;; being NIL in the body of the function.

 (defun replace (target-sequence source-sequence &key
                ((:start1 target-start) 0)
                ((:end1 target-end))
 (defun replace (target-sequence source-sequence &key
                ((:start1 target-start) 0)
                ((:end1 target-end))

@@ -451,12 +500,12 @@
 
 (eval-when (:compile-toplevel :execute)
 
 
 (eval-when (:compile-toplevel :execute)
 

-(sb!xc:defmacro vector-reverse (sequence type)
+(sb!xc:defmacro vector-reverse (sequence)

   `(let ((length (length ,sequence)))
      (declare (fixnum length))
      (do ((forward-index 0 (1+ forward-index))
          (backward-index (1- length) (1- backward-index))
   `(let ((length (length ,sequence)))
      (declare (fixnum length))
      (do ((forward-index 0 (1+ forward-index))
          (backward-index (1- length) (1- backward-index))

-         (new-sequence (make-sequence-of-type ,type length)))
+         (new-sequence (make-sequence-like sequence length)))

         ((= forward-index length) new-sequence)
        (declare (fixnum forward-index backward-index))
        (setf (aref new-sequence forward-index)
         ((= forward-index length) new-sequence)
        (declare (fixnum forward-index backward-index))
        (setf (aref new-sequence forward-index)

@@ -471,7 +520,7 @@
 
 (defun reverse (sequence)
   #!+sb-doc
 
 (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)))
   (seq-dispatch sequence
                (list-reverse* sequence)
                (vector-reverse* sequence)))

@@ -482,7 +531,7 @@
   (list-reverse-macro sequence))
 
 (defun vector-reverse* (sequence)
   (list-reverse-macro sequence))
 
 (defun vector-reverse* (sequence)

-  (vector-reverse sequence (type-of sequence)))
+  (vector-reverse sequence))

 \f
 ;;;; NREVERSE
 
 \f
 ;;;; NREVERSE
 

@@ -516,7 +565,7 @@
 
 (defun nreverse (sequence)
   #!+sb-doc
 
 (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)
    is destroyed."
   (seq-dispatch sequence
                (list-nreverse* sequence)

@@ -555,7 +604,7 @@
        (do ((sequences ,sequences (cdr sequences))
             (lengths lengths (cdr lengths))
             (index 0)
        (do ((sequences ,sequences (cdr sequences))
             (lengths lengths (cdr lengths))
             (index 0)

-            (result (make-sequence-of-type ,output-type-spec total-length)))
+            (result (make-sequence ,output-type-spec total-length)))

            ((= index total-length) result)
          (declare (fixnum index))
          (let ((sequence (car sequences)))
            ((= index total-length) result)
          (declare (fixnum index))
          (let ((sequence (car sequences)))

@@ -578,25 +627,42 @@
 
 ) ; EVAL-WHEN
 \f
 
 ) ; EVAL-WHEN
 \f

-;;; FIXME: Make a compiler macro or transform for this which efficiently
-;;; handles the case of constant 'STRING first argument. (It's not just time
-;;; efficiency, but space efficiency..)

 (defun concatenate (output-type-spec &rest sequences)
   #!+sb-doc
 (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."
   which shares no structure with the original argument sequences of the
   specified OUTPUT-TYPE-SPEC."

-  (case (type-specifier-atom output-type-spec)
-    ((simple-vector simple-string vector string array simple-array
-                   bit-vector simple-bit-vector base-string
-                   simple-base-string) ; FIXME: unifying principle here?
-     (let ((result (apply #'concat-to-simple* output-type-spec sequences)))
-       #!+high-security
-       (check-type-var result output-type-spec)
-       result))
-    (list (apply #'concat-to-list* sequences))
+  (let ((type (specifier-type output-type-spec)))
+  (cond
+    ((csubtypep type (specifier-type 'list))
+     (cond
+       ((type= type (specifier-type 'list))
+       (apply #'concat-to-list* sequences))
+       ((eq type *empty-type*)
+       (bad-sequence-type-error nil))
+       ((type= type (specifier-type 'null))
+       (if (every (lambda (x) (or (null x)
+                                  (and (vectorp x) (= (length x) 0))))
+                  sequences)
+           'nil
+           (sequence-type-length-mismatch-error type
+                                                ;; FIXME: circular
+                                                ;; list issues.  And
+                                                ;; rightward-drift.
+                                                (reduce #'+
+                                                        (mapcar #'length
+                                                                sequences)))))
+       ((csubtypep (specifier-type '(cons nil t)) type)
+       (if (notevery (lambda (x) (or (null x)
+                                     (and (vectorp x) (= (length x) 0))))
+                     sequences)
+           (apply #'concat-to-list* sequences)
+           (sequence-type-length-mismatch-error type 0)))
+       (t (sequence-type-too-hairy (type-specifier type)))))
+    ((csubtypep type (specifier-type 'vector))
+     (apply #'concat-to-simple* output-type-spec sequences))

     (t
     (t

-     (apply #'concatenate (result-type-or-lose output-type-spec) sequences))))
+     (bad-sequence-type-error output-type-spec)))))

 
 ;;; internal frobs
 ;;; FIXME: These are weird. They're never called anywhere except in
 
 ;;; internal frobs
 ;;; FIXME: These are weird. They're never called anywhere except in

@@ -609,9 +675,9 @@
 (defun concat-to-simple* (type &rest sequences)
   (concatenate-to-mumble type sequences))
 \f
 (defun concat-to-simple* (type &rest sequences)
   (concatenate-to-mumble type sequences))
 \f

-;;;; MAP
+;;;; MAP and MAP-INTO

 
 

-;;; helper functions to handle the common consing subcases of MAP
+;;; helper functions to handle arity-1 subcases of MAP

 (declaim (ftype (function (function sequence) list) %map-list-arity-1))
 (declaim (ftype (function (function sequence) simple-vector)
                %map-simple-vector-arity-1))
 (declaim (ftype (function (function sequence) list) %map-list-arity-1))
 (declaim (ftype (function (function sequence) simple-vector)
                %map-simple-vector-arity-1))

@@ -622,167 +688,168 @@
                  (simple-vector (dovector (,i sequence) ,@body))
                  (vector (dovector (,i sequence) ,@body))))))
   (defun %map-to-list-arity-1 (fun sequence)
                  (simple-vector (dovector (,i sequence) ,@body))
                  (vector (dovector (,i sequence) ,@body))))))
   (defun %map-to-list-arity-1 (fun sequence)

-    (declare (type function fun))
-    (let ((really-fun (if (functionp fun) fun (%coerce-name-to-function fun)))
-         (reversed-result nil))
+    (let ((reversed-result nil)
+         (really-fun (%coerce-callable-to-fun fun)))

       (dosequence (element sequence)
        (push (funcall really-fun element)
              reversed-result))
       (nreverse reversed-result)))
   (defun %map-to-simple-vector-arity-1 (fun sequence)
       (dosequence (element sequence)
        (push (funcall really-fun element)
              reversed-result))
       (nreverse reversed-result)))
   (defun %map-to-simple-vector-arity-1 (fun sequence)

-    (declare (type function fun))
-    (let ((really-fun (if (functionp fun) fun (%coerce-name-to-function fun)))
-         (result (make-array (length sequence)))
-         (index 0))
+    (let ((result (make-array (length sequence)))
+         (index 0)
+         (really-fun (%coerce-callable-to-fun fun)))

       (declare (type index index))
       (dosequence (element sequence)
         (setf (aref result index)
              (funcall really-fun element))
        (incf index))
       (declare (type index index))
       (dosequence (element sequence)
         (setf (aref result index)
              (funcall really-fun element))
        (incf index))

-      result)))
-
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro map-to-list (function sequences)
-  `(do ((seqs more-sequences (cdr seqs))
-       (min-length (length first-sequence)))
-       ((null seqs)
-       (let ((result (list nil)))
-         (do ((index 0 (1+ index))
-              (splice result))
-             ((= index min-length) (cdr result))
-           (declare (fixnum index))
-           (setq splice
-                 (cdr (rplacd splice
-                              (list (apply ,function (elt-slice ,sequences
-                                                                index)))))))))
-     (declare (fixnum min-length))
-     (let ((length (length (car seqs))))
-       (declare (fixnum length))
-       (if (< length min-length)
-          (setq min-length length)))))
-
-(sb!xc:defmacro map-to-simple (output-type-spec function sequences)
-  `(do ((seqs more-sequences (cdr seqs))
-       (min-length (length first-sequence)))
-       ((null seqs)
-       (do ((index 0 (1+ index))
-            (result (make-sequence-of-type ,output-type-spec min-length)))
-           ((= index min-length) result)
-         (declare (fixnum index))
-         (setf (aref result index)
-               (apply ,function (elt-slice ,sequences index)))))
-     (declare (fixnum min-length))
-     (let ((length (length (car seqs))))
-       (declare (fixnum length))
-       (if (< length min-length)
-          (setq min-length length)))))
-
-(sb!xc:defmacro map-for-effect (function sequences)
-  `(do ((seqs more-sequences (cdr seqs))
-       (min-length (length first-sequence)))
-       ((null seqs)
-       (do ((index 0 (1+ index)))
-           ((= index min-length) nil)
-         (apply ,function (elt-slice ,sequences index))))
-     (declare (fixnum min-length))
-     (let ((length (length (car seqs))))
-       (declare (fixnum length))
-       (if (< length min-length)
-          (setq min-length length)))))
-
-) ; EVAL-WHEN
-
-#!+high-security-support
-(defun get-minimum-length-sequences (sequences)
-  #!+sb-doc "Gets the minimum length of the sequences. This is
-needed to check whether the supplied type is appropriate."
-    (let ((min nil))
-      (dolist (i sequences)
-       (when (or (listp i) (vectorp i))
-         (let ((l (length i)))
-           (when (or (null min)
-                     (> min l)))
-           (setf min l))))
-      min))
-
-(defun map (output-type-spec function first-sequence &rest more-sequences)
-  #!+sb-doc
-  "FUNCTION must take as many arguments as there are sequences provided. The
-   result is a sequence such that element i is the result of applying FUNCTION
-   to element i of each of the argument sequences."
-  (let ((really-function (if (functionp function)
-                            function
-                            (%coerce-name-to-function function))))
-    ;; Pick off the easy non-consing arity-1 special case and handle
-    ;; it without consing, since the user probably didn't expect us to
-    ;; cons here. (Notably, the super duper users who wrote PCL in
-    ;; terms of quantifiers without declaring the types of their
-    ;; sequence arguments didn't expect to end up consing when SBCL
-    ;; transforms the quantifiers into calls to MAP NIL.)
-    (when (and (null more-sequences)
-              (null output-type-spec))
-      (macrolet ((frob () '(return-from map
-                            (map nil really-function first-sequence))))
-       (etypecase first-sequence
-         (simple-vector (frob))
-         (list (frob))
-         (vector (frob)))))
-    ;; Otherwise, if the user didn't give us enough information to
-    ;; simplify at compile time, we cons and cons and cons..
-    (let ((sequences (cons first-sequence more-sequences)))
-      (case (type-specifier-atom output-type-spec)
-       ((nil) (map-for-effect really-function sequences))
-       (list (map-to-list really-function sequences))
-       ((simple-vector simple-string vector string array simple-array
-                       bit-vector simple-bit-vector base-string simple-base-string)
-        #!+high-security
-        (let ((min-length-sequences (get-minimum-length-sequences
-                                     sequences))
-              (dimensions (array-type-dimensions (specifier-type
-                                                  output-type-spec))))
-          (when (or (/= (length dimensions) 1)
-                    (and (not (eq (car dimensions) '*))
-                         (/= (car dimensions) min-length-sequences)))
-            (error 'simple-type-error
-                   :datum output-type-spec
-                   :expected-type
-                   (ecase (type-specifier-atom output-type-spec)
-                     ((simple-vector bit-vector simple-bit-vector string simple-string base-string)
-                      `(,(type-specifier-atom output-type-spec) ,min-length-sequences))
-                     ((array vector simple-array)   `(,(type-specifier-atom output-type-spec) * ,min-length-sequences)))
-                   :format-control "Minimum length of sequences is ~S, this is not compatible with the type ~S."
-                   :format-arguments
-                   (list min-length-sequences output-type-spec))))
-        (let ((result (map-to-simple output-type-spec
-                                     really-function
-                                     sequences)))
-          #!+high-security
-          (check-type-var result output-type-spec)
-          result))
-       (t
-        (apply #'map (result-type-or-lose output-type-spec t)
-               really-function sequences))))))
-
-#!+high-security-support
-(defun map-without-errorchecking
-    (output-type-spec function first-sequence &rest more-sequences)
-  #!+sb-doc
-  "FUNCTION must take as many arguments as there are sequences provided. The
-   result is a sequence such that element i is the result of applying FUNCTION
-   to element I of each of the argument sequences. This version has no
-   error-checking, to pass cold-load."
-  (let ((sequences (cons first-sequence more-sequences)))
-    (case (type-specifier-atom output-type-spec)
-      ((nil) (map-for-effect function sequences))
-      (list (map-to-list function sequences))
-      ((simple-vector simple-string vector string array simple-array
-       bit-vector simple-bit-vector base-string simple-base-string)
-       (map-to-simple output-type-spec function sequences))
-      (t
-       (apply #'map (result-type-or-lose output-type-spec t)
-             function sequences)))))
-
+      result))
+  (defun %map-for-effect-arity-1 (fun sequence)
+    (let ((really-fun (%coerce-callable-to-fun fun)))
+      (dosequence (element sequence)
+       (funcall really-fun element)))
+    nil))
+
+;;; helper functions to handle arity-N subcases of MAP
+;;;
+;;; KLUDGE: This is hairier, and larger, than need be, because we
+;;; don't have DYNAMIC-EXTENT. With DYNAMIC-EXTENT, we could define
+;;; %MAP-FOR-EFFECT, and then implement the
+;;; other %MAP-TO-FOO functions reasonably efficiently by passing closures to
+;;; %MAP-FOR-EFFECT. (DYNAMIC-EXTENT would help a little by avoiding
+;;; consing each closure, and would help a lot by allowing us to define
+;;; a closure (LAMBDA (&REST REST) <do something with (APPLY FUN REST)>)
+;;; with the REST list allocated with DYNAMIC-EXTENT. -- WHN 20000920
+(macrolet (;; Execute BODY in a context where the machinery for
+          ;; UPDATED-MAP-APPLY-ARGS has been set up.
+          (with-map-state (sequences &body body)
+             `(let* ((%sequences ,sequences)
+                    (%iters (mapcar (lambda (sequence)
+                                      (etypecase sequence
+                                        (list sequence)
+                                        (vector 0)))
+                                    %sequences))
+                    (%apply-args (make-list (length %sequences))))
+               (declare (type list %sequences %iters %apply-args))
+               ,@body))
+          ;; Return a list of args to pass to APPLY for the next
+          ;; function call in the mapping, or NIL if no more function
+          ;; calls should be made (because we've reached the end of a
+          ;; sequence arg).
+          (updated-map-apply-args ()
+            '(do ((in-sequences  %sequences  (cdr in-sequences))
+                  (in-iters      %iters      (cdr in-iters))
+                  (in-apply-args %apply-args (cdr in-apply-args)))
+                 ((null in-sequences)
+                  %apply-args)
+               (declare (type list in-sequences in-iters in-apply-args))
+               (let ((i (car in-iters)))
+                 (declare (type (or list index) i))
+                 (if (listp i)
+                     (if (null i)      ; if end of this sequence
+                         (return nil)
+                         (setf (car in-apply-args) (car i)
+                               (car in-iters) (cdr i)))
+                     (let ((v (the vector (car in-sequences))))
+                       (if (>= i (length v)) ; if end of this sequence
+                           (return nil)
+                           (setf (car in-apply-args) (aref v i)
+                                 (car in-iters) (1+ i)))))))))
+  (defun %map-to-list (func sequences)
+    (declare (type function func))
+    (declare (type list sequences))
+    (with-map-state sequences
+      (loop with updated-map-apply-args 
+           while (setf updated-map-apply-args (updated-map-apply-args))
+           collect (apply func updated-map-apply-args))))
+  (defun %map-to-vector (output-type-spec func sequences)
+    (declare (type function func))
+    (declare (type list sequences))
+    (let ((min-len (with-map-state sequences
+                    (do ((counter 0 (1+ counter)))
+                        ;; Note: Doing everything in
+                        ;; UPDATED-MAP-APPLY-ARGS here is somewhat
+                        ;; wasteful; we even do some extra consing.
+                        ;; And stepping over every element of
+                        ;; VECTORs, instead of just grabbing their
+                        ;; LENGTH, is also wasteful. But it's easy
+                        ;; and safe. (If you do rewrite it, please
+                        ;; try to make sure that
+                        ;;   (MAP NIL #'F SOME-CIRCULAR-LIST #(1))
+                        ;; does the right thing.)
+                        ((not (updated-map-apply-args))
+                         counter)
+                      (declare (type index counter))))))
+      (declare (type index min-len))
+      (with-map-state sequences
+       (let ((result (make-sequence output-type-spec min-len))
+             (index 0))
+         (declare (type index index))
+         (loop with updated-map-apply-args
+               while (setf updated-map-apply-args (updated-map-apply-args))
+               do
+               (setf (aref result index)
+                     (apply func updated-map-apply-args))
+               (incf index))
+         result))))
+  (defun %map-for-effect (func sequences)
+    (declare (type function func))
+    (declare (type list sequences))
+    (with-map-state sequences
+      (loop with updated-map-apply-args
+           while (setf updated-map-apply-args (updated-map-apply-args))
+           do
+           (apply func updated-map-apply-args))
+      nil)))
+
+  "FUNCTION must take as many arguments as there are sequences provided.  
+  The result is a sequence of type OUTPUT-TYPE-SPEC such that element I 
+  is the result of applying FUNCTION to element I of each of the argument
+  sequences."
+
+;;; %MAP is just MAP without the final just-to-be-sure check that
+;;; length of the output sequence matches any length specified
+;;; in RESULT-TYPE.
+(defun %map (result-type function first-sequence &rest more-sequences)
+  (let ((really-fun (%coerce-callable-to-fun function))
+       (type (specifier-type result-type)))
+    ;; Handle one-argument MAP NIL specially, using ETYPECASE to turn
+    ;; it into something which can be DEFTRANSFORMed away. (It's
+    ;; fairly important to handle this case efficiently, since
+    ;; quantifiers like SOME are transformed into this case, and since
+    ;; there's no consing overhead to dwarf our inefficiency.)
+    (if (and (null more-sequences)
+            (null result-type))
+       (%map-for-effect-arity-1 really-fun first-sequence)
+       ;; Otherwise, use the industrial-strength full-generality
+       ;; approach, consing O(N-ARGS) temporary storage (which can have
+       ;; DYNAMIC-EXTENT), then using O(N-ARGS * RESULT-LENGTH) time.
+       (let ((sequences (cons first-sequence more-sequences)))
+         (cond
+           ((eq type *empty-type*) (%map-for-effect really-fun sequences))
+           ((csubtypep type (specifier-type 'list))
+            (%map-to-list really-fun sequences))
+           ((csubtypep type (specifier-type 'vector))
+            (%map-to-vector result-type really-fun sequences))
+           (t
+            (bad-sequence-type-error result-type)))))))
+
+(defun map (result-type function first-sequence &rest more-sequences)
+  (apply #'%map
+        result-type
+        function
+        first-sequence
+        more-sequences))
+
+;;; KLUDGE: MAP has been rewritten substantially since the fork from
+;;; CMU CL in order to give reasonable performance, but this
+;;; implementation of MAP-INTO still has the same problems as the old
+;;; MAP code. Ideally, MAP-INTO should be rewritten to be efficient in
+;;; the same way that the corresponding cases of MAP have been
+;;; rewritten. Instead of doing it now, though, it's easier to wait
+;;; until we have DYNAMIC-EXTENT, at which time it should become
+;;; extremely easy to define a reasonably efficient MAP-INTO in terms
+;;; of (MAP NIL ..). -- WHN 20000920

 (defun map-into (result-sequence function &rest sequences)
   (let* ((fp-result
          (and (arrayp result-sequence)
 (defun map-into (result-sequence function &rest sequences)
   (let* ((fp-result
          (and (arrayp result-sequence)

@@ -796,11 +863,12 @@ needed to check whether the supplied type is appropriate."
     (when fp-result
       (setf (fill-pointer result-sequence) len))
 
     (when fp-result
       (setf (fill-pointer result-sequence) len))
 

-    (dotimes (index len)
-      (setf (elt result-sequence index)
-           (apply function
-                  (mapcar #'(lambda (seq) (elt seq index))
-                          sequences)))))
+    (let ((really-fun (%coerce-callable-to-fun function)))
+      (dotimes (index len)
+       (setf (elt result-sequence index)
+             (apply really-fun
+                    (mapcar (lambda (seq) (elt seq index))
+                            sequences))))))

   result-sequence)
 \f
 ;;;; quantifiers
   result-sequence)
 \f
 ;;;; quantifiers

@@ -848,11 +916,18 @@ needed to check whether the supplied type is appropriate."
                ;; obviously correct solution is to make Python smart
                ;; enough that we can use an inline function instead
                ;; of a compiler macro (as above). -- WHN 20000410
                ;; obviously correct solution is to make Python smart
                ;; enough that we can use an inline function instead
                ;; of a compiler macro (as above). -- WHN 20000410

+               ;;
+               ;; FIXME: The DEFINE-COMPILER-MACRO here can be
+               ;; important for performance, and it'd be good to have
+               ;; it be visible throughout the compilation of all the
+               ;; target SBCL code. That could be done by defining
+               ;; SB-XC:DEFINE-COMPILER-MACRO and using it here,
+               ;; moving this DEFQUANTIFIER stuff (and perhaps other
+               ;; inline definitions in seq.lisp as well) into a new
+               ;; seq.lisp, and moving remaining target-only stuff
+               ;; from the old seq.lisp into target-seq.lisp.

                (define-compiler-macro ,name (pred first-seq &rest more-seqs)
                (define-compiler-macro ,name (pred first-seq &rest more-seqs)

-                 (let ((elements (mapcar (lambda (x)
-                                           (declare (ignore x))
-                                           (gensym "ARG"))
-                                         (cons first-seq more-seqs)))
+                 (let ((elements (make-gensym-list (1+ (length more-seqs))))

                        (blockname (gensym "BLOCK")))
                    (once-only ((pred pred))
                      `(block ,blockname
                        (blockname (gensym "BLOCK")))
                    (once-only ((pred pred))
                      `(block ,blockname

@@ -866,22 +941,22 @@ needed to check whether the supplied type is appropriate."
                              ,@more-seqs)
                         ,',unfound-result)))))))
   (defquantifier some when pred-value :unfound-result nil :doc
                              ,@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
   (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
    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
    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
   (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
    as any invocation of PREDICATE returns NIL, or NIL if every invocation
    is non-NIL."))
 \f

@@ -1094,12 +1169,12 @@ needed to check whether the supplied type is appropriate."
 (defun delete (item sequence &key from-end (test #'eql) test-not (start 0)
                end count key)
   #!+sb-doc
 (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))
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))

-        (count (or count most-positive-fixnum)))
+        (count (adjust-count count)))

     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence
     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence

@@ -1132,12 +1207,12 @@ needed to check whether the supplied type is appropriate."
 
 (defun delete-if (predicate sequence &key from-end (start 0) key end count)
   #!+sb-doc
 
 (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))
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))

-        (count (or count most-positive-fixnum)))
+        (count (adjust-count count)))

     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence
     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence

@@ -1170,12 +1245,12 @@ needed to check whether the supplied type is appropriate."
 
 (defun delete-if-not (predicate sequence &key from-end (start 0) end key count)
   #!+sb-doc
 
 (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))
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))

-        (count (or count most-positive-fixnum)))
+        (count (adjust-count count)))

     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence
     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence

@@ -1254,17 +1329,19 @@ needed to check whether the supplied type is appropriate."
   `(let* ((sequence ,(if reverse?
                         '(reverse (the list sequence))
                         'sequence))
   `(let* ((sequence ,(if reverse?
                         '(reverse (the list sequence))
                         'sequence))

+         (%start ,(if reverse? '(- length end) 'start))
+         (%end ,(if reverse? '(- length start) 'end))

          (splice (list nil))
          (results (do ((index 0 (1+ index))
                        (before-start splice))
          (splice (list nil))
          (results (do ((index 0 (1+ index))
                        (before-start splice))

-                      ((= index (the fixnum start)) before-start)
+                      ((= index (the fixnum %start)) before-start)

                     (declare (fixnum index))
                     (setq splice
                           (cdr (rplacd splice (list (pop sequence))))))))
                     (declare (fixnum index))
                     (setq splice
                           (cdr (rplacd splice (list (pop sequence))))))))

-     (do ((index start (1+ index))
+     (do ((index %start (1+ index))

          (this-element)
          (number-zapped 0))
          (this-element)
          (number-zapped 0))

-        ((or (= index (the fixnum end)) (= number-zapped (the fixnum count)))
+        ((or (= index (the fixnum %end)) (= number-zapped (the fixnum count)))

          (do ((index index (1+ index)))
              ((null sequence)
               ,(if reverse?
          (do ((index index (1+ index)))
              ((null sequence)
               ,(if reverse?

@@ -1317,12 +1394,12 @@ needed to check whether the supplied type is appropriate."
 (defun remove (item sequence &key from-end (test #'eql) test-not (start 0)
                end count key)
   #!+sb-doc
 (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))
         (end (or end length))
    EQL) with ITEM removed."
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))

-        (count (or count most-positive-fixnum)))
+        (count (adjust-count count)))

     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence
     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence

@@ -1335,12 +1412,12 @@ needed to check whether the supplied type is appropriate."
 
 (defun remove-if (predicate sequence &key from-end (start 0) end count key)
   #!+sb-doc
 
 (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))
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))

-        (count (or count most-positive-fixnum)))
+        (count (adjust-count count)))

     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence
     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence

@@ -1353,12 +1430,12 @@ needed to check whether the supplied type is appropriate."
 
 (defun remove-if-not (predicate sequence &key from-end (start 0) end count key)
   #!+sb-doc
 
 (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))
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))

-        (count (or count most-positive-fixnum)))
+        (count (adjust-count count)))

     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence
     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence

@@ -1460,7 +1537,7 @@ needed to check whether the supplied type is appropriate."
    which case the one later in the sequence is discarded. The resulting
    sequence is returned.
 
    which case the one later in the sequence is discarded. The resulting
    sequence is returned.
 

-   The :TEST-NOT argument is depreciated."
+   The :TEST-NOT argument is deprecated."

   (declare (fixnum start))
   (seq-dispatch sequence
                (if sequence
   (declare (fixnum start))
   (seq-dispatch sequence
                (if sequence

@@ -1533,7 +1610,7 @@ needed to check whether the supplied type is appropriate."
    discarded. The resulting sequence, which may be formed by destroying the
    given sequence, is returned.
 
    discarded. The resulting sequence, which may be formed by destroying the
    given sequence, is returned.
 

-   The :TEST-NOT argument is depreciated."
+   The :TEST-NOT argument is deprecated."

   (seq-dispatch sequence
     (if sequence
        (list-delete-duplicates* sequence test test-not key from-end start end))
   (seq-dispatch sequence
     (if sequence
        (list-delete-duplicates* sequence test test-not key from-end start end))

@@ -1640,13 +1717,13 @@ needed to check whether the supplied type is appropriate."
 (defun substitute (new old sequence &key from-end (test #'eql) test-not
                   (start 0) count end key)
   #!+sb-doc
 (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))
         (end (or end length))
   for details."
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))

-        (count (or count most-positive-fixnum)))
+        (count (adjust-count count)))

     (declare (type index length end)
             (fixnum count))
     (subst-dispatch 'normal)))
     (declare (type index length end)
             (fixnum count))
     (subst-dispatch 'normal)))

@@ -1655,13 +1732,13 @@ needed to check whether the supplied type is appropriate."
 
 (defun substitute-if (new test sequence &key from-end (start 0) end count key)
   #!+sb-doc
 
 (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))
         (end (or end length))
   manual for details."
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))

-        (count (or count most-positive-fixnum))
+        (count (adjust-count count))

         test-not
         old)
     (declare (type index length end)
         test-not
         old)
     (declare (type index length end)

@@ -1671,13 +1748,13 @@ needed to check whether the supplied type is appropriate."
 (defun substitute-if-not (new test sequence &key from-end (start 0)
                           end count key)
   #!+sb-doc
 (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))
         (end (or end length))
   See manual for details."
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))

-        (count (or count most-positive-fixnum))
+        (count (adjust-count count))

         test-not
         old)
     (declare (type index length end)
         test-not
         old)
     (declare (type index length end)

@@ -1689,18 +1766,20 @@ needed to check whether the supplied type is appropriate."
 (defun nsubstitute (new old sequence &key from-end (test #'eql) test-not
                     end count key (start 0))
   #!+sb-doc
 (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)))
   (declare (fixnum start))
   (let ((end (or end (length sequence)))

-       (count (or count most-positive-fixnum)))
+       (count (adjust-count count)))

     (declare (fixnum count))
     (if (listp sequence)
        (if from-end
     (declare (fixnum count))
     (if (listp sequence)
        (if from-end

-           (nreverse (nlist-substitute*
-                      new old (nreverse (the list sequence))
-                      test test-not start end count key))
+           (let ((length (length sequence)))
+             (nreverse (nlist-substitute*
+                        new old (nreverse (the list sequence))
+                        test test-not (- length end) (- length start)
+                        count key)))

            (nlist-substitute* new old sequence
                               test test-not start end count key))
        (if from-end
            (nlist-substitute* new old sequence
                               test test-not start end count key))
        (if from-end

@@ -1739,18 +1818,19 @@ needed to check whether the supplied type is appropriate."
 
 (defun nsubstitute-if (new test sequence &key from-end (start 0) end count key)
   #!+sb-doc
 
 (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)))
   (declare (fixnum start))
   (let ((end (or end (length sequence)))

-       (count (or count most-positive-fixnum)))
+       (count (adjust-count count)))

     (declare (fixnum end count))
     (if (listp sequence)
        (if from-end
     (declare (fixnum end count))
     (if (listp sequence)
        (if from-end

-           (nreverse (nlist-substitute-if*
-                      new test (nreverse (the list sequence))
-                      start end count key))
+           (let ((length (length sequence)))
+             (nreverse (nlist-substitute-if*
+                        new test (nreverse (the list sequence))
+                        (- length end) (- length start) count key)))

            (nlist-substitute-if* new test sequence
                                  start end count key))
        (if from-end
            (nlist-substitute-if* new test sequence
                                  start end count key))
        (if from-end

@@ -1779,18 +1859,19 @@ needed to check whether the supplied type is appropriate."
 (defun nsubstitute-if-not (new test sequence &key from-end (start 0)
                               end count key)
   #!+sb-doc
 (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)))
   (declare (fixnum start))
   (let ((end (or end (length sequence)))

-       (count (or count most-positive-fixnum)))
+       (count (adjust-count count)))

     (declare (fixnum end count))
     (if (listp sequence)
        (if from-end
     (declare (fixnum end count))
     (if (listp sequence)
        (if from-end

-           (nreverse (nlist-substitute-if-not*
-                      new test (nreverse (the list sequence))
-                      start end count key))
+           (let ((length (length sequence)))
+             (nreverse (nlist-substitute-if-not*
+                        new test (nreverse (the list sequence))
+                        (- length end) (- length start) count key)))

            (nlist-substitute-if-not* new test sequence
                                      start end count key))
        (if from-end
            (nlist-substitute-if-not* new test sequence
                                      start end count key))
        (if from-end

@@ -1816,276 +1897,151 @@ needed to check whether the supplied type is appropriate."
       (setf (aref sequence index) new)
       (setq count (1- count)))))
 \f
       (setf (aref sequence index) new)
       (setq count (1- count)))))
 \f

-;;; 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))
-\f
-(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))
-\f
-(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))))
+;;;; FIND, POSITION, and their -IF and -IF-NOT variants
+
+;;; logic to unravel :TEST, :TEST-NOT, and :KEY options in FIND,
+;;; POSITION-IF, etc.
+(declaim (inline effective-find-position-test effective-find-position-key))
+(defun effective-find-position-test (test test-not)
+  (cond ((and test test-not)
+        (error "can't specify both :TEST and :TEST-NOT"))
+       (test (%coerce-callable-to-fun test))
+       (test-not
+        ;; (Without DYNAMIC-EXTENT, this is potentially horribly
+        ;; inefficient, but since the TEST-NOT option is deprecated
+        ;; anyway, we don't care.)
+        (complement (%coerce-callable-to-fun test-not)))
+       (t #'eql)))
+(defun effective-find-position-key (key)
+  (if key
+      (%coerce-callable-to-fun key)
+      #'identity))
+
+;;; shared guts of out-of-line FIND, POSITION, FIND-IF, and POSITION-IF
+(macrolet (;; shared logic for defining %FIND-POSITION and
+          ;; %FIND-POSITION-IF in terms of various inlineable cases
+          ;; of the expression defined in FROB and VECTOR*-FROB
+          (frobs ()
+            `(etypecase sequence-arg
+               (list (frob sequence-arg from-end))
+               (vector 
+                (with-array-data ((sequence sequence-arg :offset-var offset)
+                                  (start start)
+                                  (end (or end (length sequence-arg))))
+                  (multiple-value-bind (f p)
+                      (macrolet ((frob2 () '(if from-end
+                                                (frob sequence t)
+                                                (frob sequence nil))))
+                        (typecase sequence
+                          (simple-vector (frob2))
+                          (simple-string (frob2))
+                          (t (vector*-frob sequence))))
+                    (declare (type (or index null) p))
+                    (values f (and p (the index (+ p offset))))))))))
+  (defun %find-position (item sequence-arg from-end start end key test)
+    (macrolet ((frob (sequence from-end)
+                `(%find-position item ,sequence
+                                 ,from-end start end key test))
+              (vector*-frob (sequence)
+                `(%find-position-vector-macro item ,sequence
+                                              from-end start end key test)))
+      (frobs)))
+  (defun %find-position-if (predicate sequence-arg from-end start end key)
+    (macrolet ((frob (sequence from-end)
+                `(%find-position-if predicate ,sequence
+                                    ,from-end start end key))
+              (vector*-frob (sequence)
+                `(%find-position-if-vector-macro predicate ,sequence
+                                                 from-end start end key)))
+      (frobs)))
+  (defun %find-position-if-not (predicate sequence-arg from-end start end key)
+    (macrolet ((frob (sequence from-end)
+                `(%find-position-if-not predicate ,sequence
+                                        ,from-end start end key))
+              (vector*-frob (sequence)
+                `(%find-position-if-not-vector-macro predicate ,sequence
+                                                 from-end start end key)))
+      (frobs))))
+
+;;; 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
+                               sequence
+                               &key
+                               from-end
+                               (start 0)
+                               end
+                               key
+                               test
+                               test-not)
+               (nth-value
+                ,values-index
+                (%find-position item
+                                sequence
+                                from-end
+                                start
+                                end
+                                (effective-find-position-key key)
+                                (effective-find-position-test test
+                                                              test-not))))))
+  (def-find-position find 0)
+  (def-find-position position 1))
+
+;;; the user interface to FIND-IF and POSITION-IF, entirely analogous
+;;; to the interface to FIND and POSITION
+(declaim (inline find-if position-if))
+(macrolet ((def-find-position-if (fun-name values-index)
+            `(defun ,fun-name (predicate sequence
+                               &key from-end (start 0) end key)
+               (nth-value
+                ,values-index
+                (%find-position-if (%coerce-callable-to-fun predicate)
+                                   sequence
+                                   from-end
+                                   start
+                                   end
+                                   (effective-find-position-key key))))))
+  
+  (def-find-position-if find-if 0)
+  (def-find-position-if position-if 1))
+
+;;; the deprecated functions FIND-IF-NOT and POSITION-IF-NOT. We
+;;; didn'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?
+;;;
+;;; FIXME: Maybe remove uses of these deprecated functions (and
+;;; definitely of :TEST-NOT) within the implementation of SBCL.
+(declaim (inline find-if-not position-if-not))
+(macrolet ((def-find-position-if-not (fun-name values-index)
+            `(defun ,fun-name (predicate sequence
+                               &key from-end (start 0) end key)
+               (nth-value
+                ,values-index
+                (%find-position-if-not (%coerce-callable-to-fun predicate)
+                                       sequence
+                                       from-end
+                                       start
+                                       end
+                                       (effective-find-position-key key))))))
+  
+  (def-find-position-if-not find-if-not 0)
+  (def-find-position-if-not position-if-not 1))

 \f
 ;;;; COUNT
 
 \f
 ;;;; COUNT
 

@@ -2120,7 +2076,7 @@ needed to check whether the supplied type is appropriate."
 (defun count (item sequence &key from-end (test #'eql) test-not (start 0)
                end key)
   #!+sb-doc
 (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))))
    which defaults to EQL."
   (declare (ignore from-end) (fixnum start))
   (let ((end (or end (length sequence))))

@@ -2154,7 +2110,7 @@ needed to check whether the supplied type is appropriate."
 
 (defun count-if (test sequence &key from-end (start 0) end key)
   #!+sb-doc
 
 (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))
   (declare (ignore from-end) (fixnum start))
   (let ((end (or end (length sequence))))
     (declare (type index end))

@@ -2185,7 +2141,7 @@ needed to check whether the supplied type is appropriate."
 
 (defun count-if-not (test sequence &key from-end (start 0) end key)
   #!+sb-doc
 
 (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))
   (declare (ignore from-end) (fixnum start))
   (let ((end (or end (length sequence))))
     (declare (type index end))

@@ -2270,14 +2226,14 @@ needed to check whether the supplied type is appropriate."
 (defun mismatch (sequence1 sequence2 &key from-end (test #'eql) test-not
                           (start1 0) end1 (start2 0) end2 key)
   #!+sb-doc
 (defun mismatch (sequence1 sequence2 &key from-end (test #'eql) test-not
                           (start1 0) end1 (start2 0) end2 key)
   #!+sb-doc

-  "The specified subsequences of Sequence1 and Sequence2 are compared
+  "The specified subsequences of SEQUENCE1 and SEQUENCE2 are compared

    element-wise. If they are of equal length and match in every element, the
    result is Nil. Otherwise, the result is a non-negative integer, the index
    element-wise. If they are of equal length and match in every element, the
    result is Nil. Otherwise, the result is a non-negative integer, the index

-   within Sequence1 of the leftmost position at which they fail to match; or,
+   within SEQUENCE1 of the leftmost position at which they fail to match; or,

    if one is shorter than and a matching prefix of the other, the index within
    if one is shorter than and a matching prefix of the other, the index within

-   Sequence1 beyond the last position tested is returned. If a non-Nil
-   :From-End keyword argument is given, then one plus the index of the
-   rightmost position in which the sequences differ is returned."
+   SEQUENCE1 beyond the last position tested is returned. If a non-NIL
+   :FROM-END argument is given, then one plus the index of the rightmost
+   position in which the sequences differ is returned."

   (declare (fixnum start1 start2))
   (let* ((length1 (length sequence1))
         (end1 (or end1 length1))
   (declare (fixnum start1 start2))
   (let* ((length1 (length sequence1))
         (end1 (or end1 length1))