X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcoerce.lisp;h=8f1507e5658dfea3739365f3119b8f56f0d91d3f;hb=d720bc359f03734ccb9baf66cb45dc01d623f369;hp=9bd1e2390eaa6fdfdef38901bc58e4a40bb25bb4;hpb=a682f4c392bc874a6a898632889319ebdd8821fc;p=sbcl.git diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp index 9bd1e23..8f1507e 100644 --- a/src/code/coerce.lisp +++ b/src/code/coerce.lisp @@ -13,16 +13,17 @@ (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)) @@ -39,12 +40,13 @@ 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 @@ -123,7 +122,7 @@ object) ((eq type *empty-type*) (coerce-error)) - ((csubtypep type (specifier-type 'character)) + ((type= type (specifier-type 'character)) (character object)) ((numberp object) (cond @@ -242,6 +241,8 @@ ((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)))