0.9.0.21:

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

diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp
index f1dca41..59bd1da 100644 (file)
--- 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