0.pre8.103:
[sbcl.git] / src / compiler / seqtran.lisp
index a938962..d67fb41 100644 (file)
          (tests `(endp ,v))
          (args-to-fn (if take-car `(car ,v) v))))
 
-      (let ((call `(funcall ,fn . ,(args-to-fn)))
-           (endtest `(or ,@(tests))))
+      (let* ((fn-sym (gensym))  ; for ONCE-ONLY-ish purposes
+            (call `(funcall ,fn-sym . ,(args-to-fn)))
+            (endtest `(or ,@(tests))))
        (ecase accumulate
          (:nconc
           (let ((temp (gensym))
                 (map-result (gensym)))
-            `(let ((,map-result (list nil)))
+            `(let ((,fn-sym ,fn)
+                   (,map-result (list nil)))
                (do-anonymous ((,temp ,map-result) . ,(do-clauses))
                              (,endtest (cdr ,map-result))
                  (setq ,temp (last (nconc ,temp ,call)))))))
          (:list
           (let ((temp (gensym))
                 (map-result (gensym)))
-            `(let ((,map-result (list nil)))
+            `(let ((,fn-sym ,fn)
+                   (,map-result (list nil)))
                (do-anonymous ((,temp ,map-result) . ,(do-clauses))
                              (,endtest (cdr ,map-result))
                  (rplacd ,temp (setq ,temp (list ,call)))))))
          ((nil)
-          `(let ((,n-first ,(first arglists)))
+          `(let ((,fn-sym ,fn)
+                 (,n-first ,(first arglists)))
              (do-anonymous ,(do-clauses)
                            (,endtest ,n-first) ,call))))))))
 
                                result-type-arg-value)))))
     `(lambda (result-type-arg fun ,@seq-names)
        (truly-the ,result-type
-        ,(cond ((policy node (> speed safety))
+        ,(cond ((policy node (< safety 3))
+                ;; ANSI requires the length-related type check only
+                ;; when the SAFETY quality is 3... in other cases, we
+                ;; skip it, because it could be expensive.
                 bare)
                ((not constant-result-type-arg-p)
                 `(sequence-of-checked-length-given-type ,bare
                                                         result-type-arg))
                (t
-                (let ((result-ctype (specifier-type result-type)))
+                (let ((result-ctype (ir1-transform-specifier-type
+                                     result-type)))
                   (if (array-type-p result-ctype)
-                      (let* ((dims (array-type-dimensions result-ctype))
-                             (dim (first dims)))
-                        (if (eq dim '*)
-                            bare
-                            `(vector-of-checked-length-given-length ,bare
-                                                                    ,dim)))
+                      (let ((dims (array-type-dimensions result-ctype)))
+                        (unless (and (listp dims) (= (length dims) 1))
+                          (give-up-ir1-transform "invalid sequence type"))
+                        (let ((dim (first dims)))
+                          (if (eq dim '*)
+                              bare
+                              `(vector-of-checked-length-given-length ,bare
+                                                                      ,dim))))
+                      ;; FIXME: this is wrong, as not all subtypes of
+                      ;; VECTOR are ARRAY-TYPEs [consider, for
+                      ;; example, (OR (VECTOR T 3) (VECTOR T
+                      ;; 4))]. However, it's difficult to see what we
+                      ;; should put here... maybe we should
+                      ;; GIVE-UP-IR1-TRANSFORM if the type is a
+                      ;; subtype of VECTOR but not an ARRAY-TYPE?
                       bare))))))))
 
 ;;; Try to compile %MAP efficiently when we can determine sequence
                    (subtypep result-type-value 'vector)
                    `(coerce (apply #'%map-to-simple-vector-arity-1 fun seqs)
                             ',result-type-value))
-                  (t (give-up-ir1-transform
-                      "internal error: unexpected sequence type"))))
+                  (t (bug "impossible (?) sequence type"))))
            (t
             (let* ((seq-args (make-gensym-list (length seqs)))
                    (index-bindingoids
                    (let ((dacc (funcall really-fun ,@values)))
                      (declare (ignorable dacc))
                      ,push-dacc))))))))))
+
+;;; MAP-INTO
+(deftransform map-into ((result fun &rest seqs)
+                        (vector * &rest *)
+                        *)
+  "open code"
+  (let ((seqs-names (mapcar (lambda (x)
+                              (declare (ignore x))
+                              (gensym))
+                            seqs)))
+    `(lambda (result fun ,@seqs-names)
+       (let ((length (array-dimension result 0))
+             (i 0))
+         (declare (type index i))
+         (declare (ignorable i))
+         ,(cond ((null seqs)
+                 `(dotimes (j length (setq i length))
+                    (setf (aref result j) (funcall fun))))
+                (t
+                 `(block nil
+                    (map nil
+                         (lambda (,@seqs-names)
+                           (when (= i length) (return))
+                           (setf (aref result i)
+                                 (funcall fun ,@seqs-names))
+                           (incf i))
+                         ,@seqs-names))))
+         (when (array-has-fill-pointer-p result)
+           (setf (fill-pointer result) i))
+         result))))
+
 \f
-(deftransform elt ((s i) ((simple-array * (*)) *) * :when :both)
+;;; FIXME: once the confusion over doing transforms with known-complex
+;;; arrays is over, we should also transform the calls to (AND (ARRAY
+;;; * (*)) (NOT (SIMPLE-ARRAY * (*)))) objects.
+(deftransform elt ((s i) ((simple-array * (*)) *) *)
   '(aref s i))
 
-(deftransform elt ((s i) (list *) * :when :both)
+(deftransform elt ((s i) (list *) * :policy (< safety 3))
   '(nth i s))
 
-(deftransform %setelt ((s i v) ((simple-array * (*)) * *) * :when :both)
+(deftransform %setelt ((s i v) ((simple-array * (*)) * *) *)
   '(%aset s i v))
 
-(deftransform %setelt ((s i v) (list * *))
+(deftransform %setelt ((s i v) (list * *) * :policy (< safety 3))
   '(setf (car (nthcdr i s)) v))
 
-(macrolet ((def-frob (name)
-             `(deftransform ,name ((e l &key (test #'eql)) * * :node node :when :both)
+(deftransform %check-vector-sequence-bounds ((vector start end)
+                                            (vector * *) *
+                                            :node node)
+  (if (policy node (< safety speed))
+      '(or end (length vector))
+      '(let ((length (length vector)))
+       (if (<= 0 start (or end length) length)
+           (or end length)
+           (sb!impl::signal-bounding-indices-bad-error vector start end)))))
+
+(macrolet ((def (name)
+             `(deftransform ,name ((e l &key (test #'eql)) * *
+                                  :node node)
                 (unless (constant-continuation-p l)
                   (give-up-ir1-transform))
 
                                       ,(frob (cdr els)))
                                  nil)))
                     (frob val))))))
-  (def-frob member)
-  (def-frob memq))
+  (def member)
+  (def memq))
 
 ;;; FIXME: We have rewritten the original code that used DOLIST to this
 ;;; more natural MACROLET.  However, the original code suggested that when
 ;;; this was done, a few bytes could be saved by a call to a shared
 ;;; function.  This remains to be done.
-(macrolet ((def-frob (fun eq-fun)
+(macrolet ((def (fun eq-fun)
              `(deftransform ,fun ((item list &key test) (t list &rest t) *)
                 "convert to EQ test"
                 ;; FIXME: The scope of this transformation could be
                 ;;   if ITEM is not a NUMBER or is a FIXNUM, apply
                 ;;   transform, else give up on transform.
                 (cond (test
-                       (unless (continuation-function-is test '(eq))
+                       (unless (continuation-fun-is test '(eq))
                          (give-up-ir1-transform)))
                       ((types-equal-or-intersect (continuation-type item)
                                                  (specifier-type 'number))
                        (give-up-ir1-transform "Item might be a number.")))
                 `(,',eq-fun item list))))
-  (def-frob delete delq)
-  (def-frob assoc assq)
-  (def-frob member memq))
+  (def delete delq)
+  (def assoc assq)
+  (def member memq))
 
 (deftransform delete-if ((pred list) (t list))
   "open code"
                    :policy (> speed space))
   "open code"
   (let ((element-type (upgraded-element-type-specifier-or-give-up seq)))
-    `(with-array-data ((data seq)
-                      (start start)
-                      (end end))
+    (values 
+     `(with-array-data ((data seq)
+                       (start start)
+                       (end end))
        (declare (type (simple-array ,element-type 1) data))
+       (declare (type fixnum start end))
        (do ((i start (1+ i)))
           ((= i end) seq)
         (declare (type index i))
         ;; WITH-ARRAY-DATA did our range checks once and for all, so
-        ;; it'd be wasteful to check again on every AREF.
+        ;; it'd be wasteful to check again on every AREF...
         (declare (optimize (safety 0))) 
-        (setf (aref data i) item)))))
+        (setf (aref data i) item)))
+     ;; ... though we still need to check that the new element can fit
+     ;; into the vector in safe code. -- CSR, 2002-07-05
+     `((declare (type ,element-type item))))))
 \f
 ;;;; utilities
 
-;;; Return true if CONT's only use is a non-notinline reference to a
+;;; Return true if CONT's only use is a non-NOTINLINE reference to a
 ;;; global function with one of the specified NAMES.
-(defun continuation-function-is (cont names)
+(defun continuation-fun-is (cont names)
   (declare (type continuation cont) (list names))
   (let ((use (continuation-use cont)))
     (and (ref-p use)
        (t
         (give-up-ir1-transform))))
 
+;;; FIXME: Why is this code commented out? (Why *was* it commented
+;;; out? We inherited this situation from cmucl-2.4.8, with no
+;;; explanation.) Should we just delete this code?
 #|
 ;;; This is a frob whose job it is to make it easier to pass around
 ;;; the arguments to IR1 transforms. It bundles together the name of
   ;; A form that returns the current value. This may be set with SETF to set
   ;; the current value.
   (current (error "Must specify CURRENT."))
-  ;; In a :Normal iterator, a form that tests whether there is a current value.
+  ;; In a :NORMAL iterator, a form that tests whether there is a current value.
   (done nil)
-  ;; In a :Result iterator, a form that truncates the result at the current
+  ;; In a :RESULT iterator, a form that truncates the result at the current
   ;; position and returns it.
   (result nil)
   ;; A form that returns the initial total number of values. The result is
 (defun make-result-sequence-iterator (name type length)
   (declare (symbol name) (type ctype type))
 
-;;; Defines each Name as a local macro that will call the value of the
-;;; Fun-Arg with the given arguments. If the argument isn't known to be a
+;;; Define each NAME as a local macro that will call the value of the
+;;; function arg with the given arguments. If the argument isn't known to be a
 ;;; function, give them an efficiency note and reference a coerced version.
-(defmacro coerce-functions (specs &body body)
+(defmacro coerce-funs (specs &body body)
   #!+sb-doc
   "COERCE-FUNCTIONS ({(Name Fun-Arg Default)}*) Form*"
   (collect ((binds)
        (abort-ir1-transform "Both ~S and ~S were supplied."
                            (arg-name ,test)
                            (arg-name ,test-not)))
-     (coerce-functions ((,name (if not-p ,test-not ,test) eql))
+     (coerce-funs ((,name (if not-p ,test-not ,test) eql))
        ,@body)))
 |#
 \f
 ;;; We transform the case-sensitive string predicates into a non-keyword
 ;;; version. This is an IR1 transform so that we don't have to worry about
 ;;; changing the order of evaluation.
-(macrolet ((def-frob (fun pred*)
+(macrolet ((def (fun pred*)
              `(deftransform ,fun ((string1 string2 &key (start1 0) end1
                                                          (start2 0) end2)
                                    * *)
                 `(,',pred* string1 string2 start1 end1 start2 end2))))
-  (def-frob string< string<*)
-  (def-frob string> string>*)
-  (def-frob string<= string<=*)
-  (def-frob string>= string>=*)
-  (def-frob string= string=*)
-  (def-frob string/= string/=*))
+  (def string< string<*)
+  (def string> string>*)
+  (def string<= string<=*)
+  (def string>= string>=*)
+  (def string= string=*)
+  (def string/= string/=*))
 
 ;;; Return a form that tests the free variables STRING1 and STRING2
 ;;; for the ordering relationship specified by LESSP and EQUALP. The
 ;;; start and end are also gotten from the environment. Both strings
 ;;; must be SIMPLE-STRINGs.
-(macrolet ((def-frob (name lessp equalp)
+(macrolet ((def (name lessp equalp)
              `(deftransform ,name ((string1 string2 start1 end1 start2 end2)
                                     (simple-string simple-string t t t t) *)
                 `(let* ((end1 (if (not end1) (length string1) end1))
                                       (truly-the index
                                                  (+ index
                                                     (truly-the fixnum
-                                                               (- start2 start1))))))
+                                                               (- start2
+                                                                 start1))))))
                              index)
                             (t nil))
                       ,(if ',equalp 'end1 nil))))))
-  (def-frob string<* t nil)
-  (def-frob string<=* t t)
-  (def-frob string>* nil nil)
-  (def-frob string>=* nil t))
+  (def string<* t nil)
+  (def string<=* t t)
+  (def string>* nil nil)
+  (def string>=* nil t))
 
-(macrolet ((def-frob (name result-fun)
+(macrolet ((def (name result-fun)
              `(deftransform ,name ((string1 string2 start1 end1 start2 end2)
                                    (simple-string simple-string t t t t) *)
                 `(,',result-fun
                   (sb!impl::%sp-string-compare
                    string1 start1 (or end1 (length string1))
                    string2 start2 (or end2 (length string2)))))))
-  (def-frob string=* not)
-  (def-frob string/=* identity))
+  (def string=* not)
+  (def string/=* identity))
 
 \f
 ;;;; string-only transforms for sequence functions
 ;;;; calls when all arguments are vectors with the same element type,
 ;;;; rather than restricting them to STRINGs only.
 
-;;; FIXME: Shouldn't we be testing for legality of
-;;;   * START1, START2, END1, and END2 indices?
-;;;   * size of copied string relative to destination string?
-;;; (Either there should be tests conditional on SAFETY>=SPEED, or
-;;; the transform should be conditional on SPEED>SAFETY.)
+;;; Moved here from generic/vm-tran.lisp to satisfy clisp
 ;;;
-;;; FIXME: Also, the transform should probably be dependent on
-;;; SPEED>SPACE.
+;;; FIXME: Add a comment telling whether this holds for all vectors
+;;; or only for vectors based on simple arrays (non-adjustable, etc.).
+(def!constant vector-data-bit-offset
+  (* sb!vm:vector-data-offset sb!vm:n-word-bits))
+
 (deftransform replace ((string1 string2 &key (start1 0) (start2 0)
                                end1 end2)
-                      (simple-string simple-string &rest t))
+                      (simple-string simple-string &rest t)
+                      *
+                      ;; FIXME: consider replacing this policy test
+                      ;; with some tests for the STARTx and ENDx
+                      ;; indices being valid, conditional on high
+                      ;; SAFETY code.
+                      ;;
+                      ;; FIXME: It turns out that this transform is
+                      ;; critical for the performance of string
+                      ;; streams.  Make this more explicit.
+                      :policy (< (max safety space) 3))
   `(locally
      (declare (optimize (safety 0)))
      (bit-bash-copy string2
 ;;; %CONCATENATE (with a DEFTRANSFORM to translate constant RTYPE to
 ;;; CTYPE before calling %CONCATENATE) which is comparably efficient,
 ;;; at least once DYNAMIC-EXTENT works.
+;;;
+;;; FIXME: currently KLUDGEed because of bug 188
 (deftransform concatenate ((rtype &rest sequences)
                           (t &rest simple-string)
-                          simple-string)
+                          simple-string
+                          :policy (< safety 3))
   (collect ((lets)
            (forms)
            (all-lengths)
            (args))
     (dolist (seq sequences)
-      (declare (ignore seq))
+      (declare (ignorable seq))
       (let ((n-seq (gensym))
            (n-length (gensym)))
        (args n-seq)
        (forms `(bit-bash-copy ,n-seq ,vector-data-bit-offset
                               res start
                               ,n-length))
-       (forms `(setq start (+ start ,n-length)))))
+       (forms `(setq start (opaque-identity (+ start ,n-length))))))
     `(lambda (rtype ,@(args))
        (declare (ignore rtype))
-       (let* (,@(lets)
-             (res (make-string (truncate (the index (+ ,@(all-lengths)))
-                                         sb!vm:n-byte-bits)))
-             (start ,vector-data-bit-offset))
-        (declare (type index start ,@(all-lengths)))
-        ,@(forms)
-        res))))
+       ;; KLUDGE
+       (flet ((opaque-identity (x) x))
+        (declare (notinline opaque-identity))
+        (let* (,@(lets)
+                 (res (make-string (truncate (the index (+ ,@(all-lengths)))
+                                             sb!vm:n-byte-bits)))
+                 (start ,vector-data-bit-offset))
+          (declare (type index start ,@(all-lengths)))
+          ,@(forms)
+          res)))))
 \f
 ;;;; CONS accessor DERIVE-TYPE optimizers
 
           (give-up-ir1-transform
            "sequence type not known at compile time")))))
 
-;;; %FIND-POSITION-IF for LIST data
-(deftransform %find-position-if ((predicate sequence from-end start end key)
-                                (function list t t t function)
-                                *
-                                :policy (> speed space)
-                                :important t)
-  "expand inline"
-  '(let ((index 0)
-        (find nil)
-        (position nil))
-     (declare (type index index))
-     (dolist (i sequence (values find position))
-       (let ((key-i (funcall key i)))
-        (when (and end (>= index end))
-          (return (values find position)))
-        (when (>= index start)
-          (when (funcall predicate key-i)
-            ;; This hack of dealing with non-NIL FROM-END for list
-            ;; data by iterating forward through the list and keeping
-            ;; track of the last time we found a match might be more
-            ;; screwy than what the user expects, but it seems to be
-            ;; allowed by the ANSI standard. (And if the user is
-            ;; screwy enough to ask for FROM-END behavior on list
-            ;; data, turnabout is fair play.)
-            ;;
-            ;; It's also not enormously efficient, calling PREDICATE
-            ;; and KEY more often than necessary; but all the
-            ;; alternatives seem to have their own efficiency
-            ;; problems.
-            (if from-end
-                (setf find i
-                      position index)
-                (return (values i index))))))
-       (incf index))))
-
+;;; %FIND-POSITION-IF and %FIND-POSITION-IF-NOT for LIST data
+(macrolet ((def (name condition)
+            `(deftransform ,name ((predicate sequence from-end start end key)
+                                  (function list t t t function)
+                                  *
+                                  :policy (> speed space)
+                                  :important t)
+               "expand inline"
+               `(let ((index 0)
+                      (find nil)
+                      (position nil))
+                  (declare (type index index))
+                  (dolist (i sequence
+                           (if (and end (> end index))
+                               (sb!impl::signal-bounding-indices-bad-error
+                                sequence start end)
+                               (values find position)))
+                    (let ((key-i (funcall key i)))
+                      (when (and end (>= index end))
+                        (return (values find position)))
+                      (when (>= index start)
+                        (,',condition (funcall predicate key-i)
+                         ;; This hack of dealing with non-NIL
+                         ;; FROM-END for list data by iterating
+                         ;; forward through the list and keeping
+                         ;; track of the last time we found a match
+                         ;; might be more screwy than what the user
+                         ;; expects, but it seems to be allowed by
+                         ;; the ANSI standard. (And if the user is
+                         ;; screwy enough to ask for FROM-END
+                         ;; behavior on list data, turnabout is
+                         ;; fair play.)
+                         ;;
+                         ;; It's also not enormously efficient,
+                         ;; calling PREDICATE and KEY more often
+                         ;; than necessary; but all the
+                         ;; alternatives seem to have their own
+                         ;; efficiency problems.
+                         (if from-end
+                             (setf find i
+                                   position index)
+                             (return (values i index))))))
+                    (incf index))))))
+  (def %find-position-if when)
+  (def %find-position-if-not unless))
+                     
 ;;; %FIND-POSITION for LIST data can be expanded into %FIND-POSITION-IF
 ;;; without loss of efficiency. (I.e., the optimizer should be able
 ;;; to straighten everything out.)
                              :important t)
   "expand inline"
   '(%find-position-if (let ((test-fun (%coerce-callable-to-fun test)))
-                       ;; I'm having difficulty believing I'm
-                       ;; reading it right, but as far as I can see,
-                       ;; the only guidance that ANSI gives for the
-                       ;; order of arguments to asymmetric tests is
-                       ;; the character-set dependent example from
-                       ;; the definition of FIND,
-                       ;;   (find #\d "here are some.." :test #'char>)
-                       ;;     => #\Space
-                       ;; (In ASCII, we have (CHAR> #\d #\SPACE)=>T.)
-                       ;; (Neither the POSITION definition page nor
-                       ;; section 17.2 ("Rules about Test Functions")
-                       ;; seem to consider the possibility of
-                       ;; asymmetry.)
-                       ;;
-                       ;; So, judging from the example, we want to
-                       ;; do (FUNCALL TEST-FUN ITEM I), because
-                       ;; (FUNCALL #'CHAR> #\d #\SPACE)=>T.
-                       ;;
-                       ;; -- WHN (whose attention was drawn to it by
-                       ;;         Alexey Dejneka's bug report/fix)
+                       ;; The order of arguments for asymmetric tests
+                       ;; (e.g. #'<, as opposed to order-independent
+                       ;; tests like #'=) is specified in the spec
+                       ;; section 17.2.1 -- the O/Zi stuff there.
                        (lambda (i)
                          (funcall test-fun item i)))
                      sequence
           (,n-end ,end-arg))
        (with-array-data ((,sequence ,n-sequence :offset-var ,offset)
                         (,start ,start)
-                        (,end (or ,n-end (length ,n-sequence))))
+                        (,end (%check-vector-sequence-bounds
+                               ,n-sequence ,start ,n-end)))
          (block ,block
           (macrolet ((maybe-return ()
                        '(let ((,element (aref ,sequence ,index)))
      element
      `(funcall ,predicate (funcall ,key ,element)))))
 
-;;; %FIND-POSITION and %FIND-POSITION-IF for VECTOR data
+(def!macro %find-position-if-not-vector-macro (predicate sequence
+                                                        from-end start end key)
+  (let ((element (gensym "ELEMENT")))
+    (%find-position-or-find-position-if-vector-expansion
+     sequence
+     from-end
+     start
+     end
+     element
+     `(not (funcall ,predicate (funcall ,key ,element))))))
+
+;;; %FIND-POSITION, %FIND-POSITION-IF and %FIND-POSITION-IF-NOT for
+;;; VECTOR data
 (deftransform %find-position-if ((predicate sequence from-end start end key)
                                 (function vector t t t function)
                                 *
   (check-inlineability-of-find-position-if sequence from-end)
   '(%find-position-if-vector-macro predicate sequence
                                   from-end start end key))
+
+(deftransform %find-position-if-not ((predicate sequence from-end start end key)
+                                    (function vector t t t function)
+                                    *
+                                    :policy (> speed space)
+                                    :important t)
+  "expand inline"
+  (check-inlineability-of-find-position-if sequence from-end)
+  '(%find-position-if-not-vector-macro predicate sequence
+                                       from-end start end key))
+
 (deftransform %find-position ((item sequence from-end start end key test)
                              (t vector t t t function function)
                              *
   (check-inlineability-of-find-position-if sequence from-end)
   '(%find-position-vector-macro item sequence
                                from-end start end key test))
+
+;;; logic to unravel :TEST, :TEST-NOT, and :KEY options in FIND,
+;;; POSITION-IF, etc.
+(define-source-transform effective-find-position-test (test test-not)
+  (once-only ((test test)
+             (test-not 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))))
+(define-source-transform effective-find-position-key (key)
+  (once-only ((key key))
+    `(if ,key
+        (%coerce-callable-to-fun ,key)
+        #'identity)))
+
+(macrolet ((define-find-position (fun-name values-index)
+            `(deftransform ,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))))))
+  (define-find-position find 0)
+  (define-find-position position 1))
+
+(macrolet ((define-find-position-if (fun-name values-index)
+            `(deftransform ,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))))))
+  (define-find-position-if find-if 0)
+  (define-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.
+(macrolet ((define-find-position-if-not (fun-name values-index)
+              `(deftransform ,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))))))
+  (define-find-position-if-not find-if-not 0)
+  (define-find-position-if-not position-if-not 1))