0.7.9.21:
[sbcl.git] / src / code / seq.lisp
index 90639c2..77e232e 100644 (file)
@@ -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.
-;;; 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)
 (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
@@ -56,7 +98,7 @@
             :datum vector
             :expected-type `(vector ,declared-length)
             :format-control
-            "Vector length (~D) doesn't match declared length (~D)."
+            "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)
              (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))
-        (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
                              ;; 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."
   (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)
-              (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
 ;;;;
-;;;; 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))
-  (when (null end) (setf end (length sequence)))
+  (if (null end)
+      (setf end (length sequence))
+      (unless (<= end (length sequence))
+       (signal-index-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))
-    (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))
              (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
 
 (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))
-         (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)))))
   (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
 
 
 (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))
-         (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)
   (list-reverse-macro sequence))
 
 (defun vector-reverse* (sequence)
-  (vector-reverse sequence (type-of sequence)))
+  (vector-reverse sequence))
 \f
 ;;;; NREVERSE
 
        (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)))
 
 ) ; 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."
-  (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
-     (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
                       (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
 ;;; length of the output sequence matches any length specified
 ;;; in RESULT-TYPE.
 (defun %map (result-type function first-sequence &rest more-sequences)
-  (let ((really-function (%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
     ;; there's no consing overhead to dwarf our inefficiency.)
     (if (and (null more-sequences)
             (null result-type))
-       (%map-for-effect-arity-1 really-function first-sequence)
+       (%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)))
-         (case (type-specifier-atom result-type)
-           ((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)
-            (%map-to-vector result-type really-function 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
-            (apply #'map
-                   (result-type-or-lose result-type t)
-                   really-function
-                   sequences)))))))
+            (bad-sequence-type-error result-type)))))))
 
 (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
       (dotimes (index len)
        (setf (elt result-sequence index)
              (apply really-fun
-                    (mapcar #'(lambda (seq) (elt seq index))
+                    (mapcar (lambda (seq) (elt seq index))
                             sequences))))))
   result-sequence)
 \f
   (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 (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 (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
   `(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))
-                      ((= index (the fixnum start)) before-start)
+                      ((= index (the fixnum %start)) before-start)
                     (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))
-        ((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?
   (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 (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 (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
    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
    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))
   (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 (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)
   (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)
   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
    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
    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
               (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
   (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 don't
-;;; bother to worry about optimizing them.
-;;;
-;;; (Except note that on Sat, Oct 06, 2001 at 04:22:38PM +0100,
-;;; Christophe Rhodes wrote on sbcl-devel
+;;; 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
 ;;;     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
                                &key from-end (start 0) end key)
                (nth-value
                 ,values-index
-                (%find-position-if (complement (%coerce-callable-to-fun
-                                                predicate))
-                                   sequence
-                                   from-end
-                                   start
-                                   end
-                                   (effective-find-position-key key))))))
+                (%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