X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fseq.lisp;h=2cd9d5287ace4d5546742cea1194f927c163b528;hb=22c592cbf7e81e78ceaef80d1c15ad7a7fc3b40a;hp=12fa57329bcddc68fe026385edcaadfc4561ce8f;hpb=768739723a84f1b7c2c1b05f79f19c8e0c602d4b;p=sbcl.git

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 12fa573..2cd9d52 100644
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -266,6 +266,16 @@
            :type '(and list (satisfies list-length)))))
 
 
+
+(defun emptyp (sequence)
+  #!+sb-doc
+  "Returns T if SEQUENCE is an empty sequence and NIL
+   otherwise. Signals an error if SEQUENCE is not a sequence."
+  (seq-dispatch sequence
+                (null sequence)
+                (zerop (length sequence))
+                (sb!sequence:emptyp sequence)))
+
 (defun elt (sequence index)
   #!+sb-doc "Return the element of SEQUENCE specified by INDEX."
   (seq-dispatch sequence
@@ -851,14 +861,10 @@ many elements are copied."
            ((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.
-                 (reduce #'+ sequences :key #'length))))
+            (unless (every #'emptyp sequences)
+              (sequence-type-length-mismatch-error
+               type (reduce #'+ sequences :key #'length))) ; FIXME: circular list issues.
+            '())
            ((cons-type-p type)
             (multiple-value-bind (min exactp)
                 (sb!kernel::cons-type-length-info type)
@@ -2180,7 +2186,8 @@ many elements are copied."
     (apply #'sb!sequence:nsubstitute-if new predicate sequence args)))
 
 (defun nlist-substitute-if* (new test sequence start end count key)
-  (declare (fixnum end))
+  (declare (type fixnum end)
+           (type function test)) ; coercion is done by caller
   (do ((list (nthcdr start sequence) (cdr list))
        (index start (1+ index)))
       ((or (= index end) (null list) (= count 0)) sequence)
@@ -2190,6 +2197,8 @@ many elements are copied."
 
 (defun nvector-substitute-if* (new test sequence incrementer
                                start end count key)
+  (declare (type fixnum end)
+           (type function test)) ; coercion is done by caller
   (do ((index start (+ index incrementer)))
       ((or (= index end) (= count 0)) sequence)
     (when (funcall test (apply-key key (aref sequence index)))
@@ -2223,7 +2232,8 @@ many elements are copied."
     (apply #'sb!sequence:nsubstitute-if-not new predicate sequence args)))
 
 (defun nlist-substitute-if-not* (new test sequence start end count key)
-  (declare (fixnum end))
+  (declare (type fixnum end)
+           (type function test)) ; coercion is done by caller
   (do ((list (nthcdr start sequence) (cdr list))
        (index start (1+ index)))
       ((or (= index end) (null list) (= count 0)) sequence)
@@ -2233,6 +2243,8 @@ many elements are copied."
 
 (defun nvector-substitute-if-not* (new test sequence incrementer
                                    start end count key)
+  (declare (type fixnum end)
+           (type function test)) ; coercion is done by caller
   (do ((index start (+ index incrementer)))
       ((or (= index end) (= count 0)) sequence)
     (when (not (funcall test (apply-key key (aref sequence index))))