Inherit FP modes for new threads on Windows.
[sbcl.git] / src / code / coerce.lisp
index 9bd1e23..8f1507e 100644 (file)
 
 (macrolet ((def (name result access src-type &optional typep)
              `(defun ,name (object ,@(if typep '(type) ()))
+                (declare (type ,(ecase src-type
+                                       (:list 'list)
+                                       (:vector 'vector)
+                                       (:sequence 'sequence)) object))
                 (do* ((index 0 (1+ index))
-                      (length (length (the ,(ecase src-type
-                                              (:list 'list)
-                                              (:vector 'vector)
-                                              (:sequence 'sequence))
-                                           object)))
+                      (length (length object))
                       (result ,result)
                       (in-object object))
-                     ((= index length) result)
+                     ((>= index length) result)
                   (declare (fixnum length index))
+                  (declare (type vector result))
                   (setf (,access result index)
                         ,(ecase src-type
                            (:list '(pop in-object))
     aref :sequence t))
 
 (defun vector-to-list* (object)
+  (declare (type vector object))
   (let ((result (list nil))
         (length (length object)))
     (declare (fixnum length))
     (do ((index 0 (1+ index))
          (splice result (cdr splice)))
-        ((= index length) (cdr result))
+        ((>= index length) (cdr result))
       (declare (fixnum index))
       (rplacd splice (list (aref object index))))))
 
@@ -78,9 +80,6 @@
         ;; FIXME: If we go to a compiler-only implementation, this can
         ;; become COMPILE instead of EVAL, which seems nicer to me.
         (eval `(function ,object)))
-       ((instance-lambda)
-        (deprecation-warning 'instance-lambda 'lambda)
-        (eval `(function ,object)))
        (t
         (error 'simple-type-error
                :datum object
          object)
         ((eq type *empty-type*)
          (coerce-error))
-        ((csubtypep type (specifier-type 'character))
+        ((type= type (specifier-type 'character))
          (character object))
         ((numberp object)
          (cond
         ((and (csubtypep type (specifier-type 'sequence))
               (find-class output-type-spec nil))
          (let ((class (find-class output-type-spec)))
+           (unless (sb!mop:class-finalized-p class)
+             (sb!mop:finalize-inheritance class))
            (sb!sequence:make-sequence-like
             (sb!mop:class-prototype class)
             (length object) :initial-contents object)))