X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fseq.lisp;h=9446dc87e472bb6365e283d2a02f4844aaa706c4;hb=6c4d4d984b1af6b2a73568cec3ab9c8795cff2da;hp=93bfa196614cf1106db0374a81433575090a09b0;hpb=c33612272b00979a34861d962f5e7bd47f36ae6e;p=sbcl.git

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 93bfa19..9446dc8 100644
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -634,10 +634,33 @@
   specified OUTPUT-TYPE-SPEC."
   (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))
-    ((csubtypep type (specifier-type 'list))
-     (apply #'concat-to-list* sequences))
     (t
      (bad-sequence-type-error output-type-spec)))))