X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcoerce.lisp;h=59bd1da19739950d3a97c5aa42f91f6304b58341;hb=fd00d78accb69be3a626a29120ba17a18569b98c;hp=f1dca41e23bcb23ce367125109aef3bb56d8b0a1;hpb=b956ed4f9cef685d1b49be28dcd2aec1e082d994;p=sbcl.git

diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp
index f1dca41..59bd1da 100644
--- a/src/code/coerce.lisp
+++ b/src/code/coerce.lisp
@@ -179,6 +179,9 @@
 		     ((csubtypep type (specifier-type '(complex long-float)))
 		      (complex (%long-float (realpart object))
 			       (%long-float (imagpart object))))
+                     ((csubtypep type (specifier-type '(complex float)))
+                      (complex (%single-float (realpart object))
+                               (%single-float (imagpart object))))
 		     ((and (typep object 'rational)
 			   (csubtypep type (specifier-type '(complex float))))
 		      ;; Perhaps somewhat surprisingly, ANSI specifies
@@ -203,18 +206,25 @@
 	      res))))
 	((csubtypep type (specifier-type 'list))
 	 (if (vectorp object)
-	     (cond ((type= type (specifier-type 'list))
-		    (vector-to-list* object))
-		   ((type= type (specifier-type 'null))
-		    (if (= (length object) 0)
-			'nil
-			(sequence-type-length-mismatch-error type
-							     (length object))))
-		   ((csubtypep (specifier-type '(cons nil t)) type)
-		    (if (> (length object) 0)
-			(vector-to-list* object)
-			(sequence-type-length-mismatch-error type 0)))
-		   (t (sequence-type-too-hairy (type-specifier type))))
+	     (cond
+	       ((type= type (specifier-type 'list))
+		(vector-to-list* object))
+	       ((type= type (specifier-type 'null))
+		(if (= (length object) 0)
+		    'nil
+		    (sequence-type-length-mismatch-error type
+							 (length object))))
+	       ((cons-type-p type)
+		(multiple-value-bind (min exactp)
+		    (sb!kernel::cons-type-length-info type)
+		  (let ((length (length object)))
+		    (if exactp
+			(unless (= length min)
+			  (sequence-type-length-mismatch-error type length))
+			(unless (>= length min)
+			  (sequence-type-length-mismatch-error type length)))
+		    (vector-to-list* object))))
+	       (t (sequence-type-too-hairy (type-specifier type))))
 	     (coerce-error)))
 	((csubtypep type (specifier-type 'vector))
 	 (typecase object