0.7.4.3:

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

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 8463694..7a20475 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -289,7 +289,17 @@
   (list-copy-seq sequence))
 
 (defun vector-copy-seq* (sequence)
-  (vector-copy-seq sequence (type-of sequence)))
+  (declare (type vector sequence))
+  (vector-copy-seq sequence
+                  (typecase sequence
+                    ;; Pick off the common cases so that we don't have to... 
+                    ((vector t) 'simple-vector)
+                    (string 'simple-string)
+                    (bit-vector 'simple-bit-vector)
+                    ((vector single-float) '(simple-array single-float 1))
+                    ((vector double-float) '(simple-array double-float 1))
+                    ;; ...do a full call to TYPE-OF.
+                    (t (type-of sequence)))))
 \f
 ;;;; FILL
 
@@ -760,7 +770,7 @@
 ;;; 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)))
     ;; 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
@@ -768,21 +778,21 @@
     ;; 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))
+           ((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)
-            (%map-to-vector result-type really-function sequences))
+            (%map-to-vector result-type really-fun sequences))
            (t
             (apply #'map
                    (result-type-or-lose result-type t)
-                   really-function
+                   really-fun
                    sequences)))))))
 
 (defun map (result-type function first-sequence &rest more-sequences)
@@ -830,7 +840,7 @@
       (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
@@ -1910,6 +1920,14 @@
               (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
@@ -1956,11 +1974,10 @@
   (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
@@ -1981,18 +1998,19 @@
 ;;;
 ;;; FIXME: Remove uses of these deprecated functions (and of :TEST-NOT
 ;;; too) 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