0.7.8.36:

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

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 68753f0..8d09e37 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -36,19 +36,16 @@
 (sb!xc:defmacro make-sequence-like (sequence length)
   #!+sb-doc
   "Return a sequence of the same type as SEQUENCE and the given LENGTH."
-  (let ((type (gensym "TYPE-")))
-    `(if *type-system-initialized*
-        (let ((,type (specifier-type (type-of ,sequence))))
-          (if (csubtypep ,type (specifier-type 'list))
-              (make-sequence 'list ,length)
-            (progn
-              (aver (csubtypep ,type (specifier-type 'vector)))
-              (aver (array-type-p ,type))
-              (setf (array-type-dimensions ,type) (list '*))
-              (make-sequence (type-specifier ,type) ,length))))
-         (if (typep ,sequence 'string)
-            (make-string ,length)
-            (error "MAKE-SEQUENCE-LIKE on non-STRING too early in cold-init")))))
+  `(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
@@ -107,6 +104,14 @@
                              `(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."
@@ -1109,7 +1114,7 @@
   (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
@@ -1147,7 +1152,7 @@
   (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
@@ -1185,7 +1190,7 @@
   (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
@@ -1332,7 +1337,7 @@
   (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
@@ -1350,7 +1355,7 @@
   (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
@@ -1368,7 +1373,7 @@
   (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
@@ -1656,7 +1661,7 @@
   (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)))
@@ -1671,7 +1676,7 @@
   (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)
@@ -1687,7 +1692,7 @@
   (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)
@@ -1704,7 +1709,7 @@
   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
@@ -1754,7 +1759,7 @@
    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
@@ -1794,7 +1799,7 @@
    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