0.7.9.29:

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

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index adf36db..fe09338 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -26,7 +26,7 @@
 ;;;
 ;;; FIXME: It might be worth making three cases here, LIST,
 ;;; SIMPLE-VECTOR, and VECTOR, instead of the current LIST and VECTOR.
 ;;;
 ;;; 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
+;;; 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)
 ;;; is needed to decide.
 (sb!xc:defmacro seq-dispatch (sequence list-form array-form)
   `(if (listp ,sequence)

@@ -36,12 +36,54 @@
 (sb!xc:defmacro make-sequence-like (sequence length)
   #!+sb-doc
   "Return a sequence of the same type as SEQUENCE and the given LENGTH."
 (sb!xc:defmacro make-sequence-like (sequence length)
   #!+sb-doc
   "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 "Return the broad class of which TYPE is a specific subclass."
-  `(if (atom ,type) ,type (car ,type)))
-
+  `(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
 
 ;;; It's possible with some sequence operations to declare the length
 ) ; EVAL-WHEN
 
 ;;; It's possible with some sequence operations to declare the length

@@ -69,36 +111,10 @@
              (vector-of-checked-length-given-length sequence
                                                     declared-length))))))
 
              (vector-of-checked-length-given-length sequence
                                                     declared-length))))))
 

-;;; 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
-                 "A NIL output type is 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 not a legal type specifier for sequence functions."
-             :format-arguments (list type))))))
-

 (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

@@ -106,21 +122,24 @@
                              ;; 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 "Return 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)
   #!+sb-doc "Return the element of SEQUENCE specified by INDEX."
 \f
 (defun elt (sequence index)
   #!+sb-doc "Return the element of SEQUENCE specified by INDEX."

@@ -167,61 +186,74 @@
   (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=~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))

@@ -240,10 +272,10 @@
              (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
   "Return a copy of a subsequence of SEQUENCE starting with element number
 (defun subseq (sequence start &optional end)
   #!+sb-doc
   "Return a copy of a subsequence of SEQUENCE starting with element number

@@ -256,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)))))

@@ -289,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
 

@@ -467,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)

@@ -498,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
 

@@ -571,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)))

@@ -594,24 +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
   "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."
 (defun concatenate (output-type-spec &rest sequences)
   #!+sb-doc
   "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)
-    ((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 (aver (typep 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

@@ -731,7 +782,7 @@
                       (declare (type index counter))))))
       (declare (type index min-len))
       (with-map-state sequences
                       (declare (type index counter))))))
       (declare (type index min-len))
       (with-map-state sequences

-       (let ((result (make-sequence-of-type output-type-spec min-len))
+       (let ((result (make-sequence output-type-spec min-len))

              (index 0))
          (declare (type index index))
          (loop with updated-map-apply-args
              (index 0))
          (declare (type index index))
          (loop with updated-map-apply-args

@@ -760,7 +811,8 @@
 ;;; length of the output sequence matches any length specified
 ;;; in RESULT-TYPE.
 (defun %map (result-type function first-sequence &rest more-sequences)
 ;;; 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)))
+  (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
     ;; 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

@@ -773,36 +825,21 @@
        ;; 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)))
        ;; 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)))

-         (case (type-specifier-atom result-type)
-           ((nil) (%map-for-effect really-fun sequences))
-           (list (%map-to-list really-fun sequences))
-           ((simple-vector simple-string vector string array simple-array
-             bit-vector simple-bit-vector base-string simple-base-string)
+         (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
             (%map-to-vector result-type really-fun sequences))
            (t

-            (apply #'map
-                   (result-type-or-lose result-type t)
-                   really-fun
-                   sequences)))))))
+            (bad-sequence-type-error result-type)))))))

 
 (defun map (result-type function first-sequence &rest more-sequences)
 
 (defun map (result-type function first-sequence &rest more-sequences)

-  (sequence-of-checked-length-given-type (apply #'%map
-                                               result-type
-                                               function
-                                               first-sequence
-                                               more-sequences)
-                                        ;; (The RESULT-TYPE isn't
-                                        ;; strictly the type of the
-                                        ;; result, because when
-                                        ;; RESULT-TYPE=NIL, the result
-                                        ;; actually has NULL type. But
-                                        ;; that special case doesn't
-                                        ;; matter here, since we only
-                                        ;; look closely at vector
-                                        ;; types; so we can just pass
-                                        ;; RESULT-TYPE straight through
-                                        ;; as a type specifier.)
-                                        result-type))
+  (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
 
 ;;; KLUDGE: MAP has been rewritten substantially since the fork from
 ;;; CMU CL in order to give reasonable performance, but this

@@ -1137,7 +1174,7 @@
   (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

@@ -1175,7 +1212,7 @@
   (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

@@ -1213,7 +1250,7 @@
   (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

@@ -1292,17 +1329,19 @@
   `(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?

@@ -1360,7 +1399,7 @@
   (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

@@ -1378,7 +1417,7 @@
   (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

@@ -1396,7 +1435,7 @@
   (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

@@ -1498,7 +1537,7 @@
    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

@@ -1571,7 +1610,7 @@
    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))

@@ -1684,7 +1723,7 @@
   (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))
     (subst-dispatch 'normal)))
     (declare (type index length end)
             (fixnum count))
     (subst-dispatch 'normal)))

@@ -1699,7 +1738,7 @@
   (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))

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

@@ -1715,7 +1754,7 @@
   (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))

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

@@ -1732,13 +1771,15 @@
   may be destructively modified. See manual for details."
   (declare (fixnum start))
   (let ((end (or end (length sequence)))
   may be destructively modified. See manual for details."
   (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

@@ -1782,13 +1823,14 @@
    SEQUENCE may be destructively modified. See manual for details."
   (declare (fixnum start))
   (let ((end (or end (length sequence)))
    SEQUENCE may be destructively modified. See manual for details."
   (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

@@ -1822,13 +1864,14 @@
    SEQUENCE may be destructively modified. See manual for details."
   (declare (fixnum start))
   (let ((end (or end (length sequence)))
    SEQUENCE may be destructively modified. See manual for details."
   (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

@@ -1982,12 +2025,8 @@
 ;;;     perhaps it's worth optimizing the -if-not versions in the same
 ;;;     way as the others?
 ;;;
 ;;;     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.
+;;; 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
 (declaim (inline find-if-not position-if-not))
 (macrolet ((def-find-position-if-not (fun-name values-index)
             `(defun ,fun-name (predicate sequence