diff --git a/src/cmp/cmpfun.lsp b/src/cmp/cmpfun.lsp index 467832965..dfed37f22 100644 --- a/src/cmp/cmpfun.lsp +++ b/src/cmp/cmpfun.lsp @@ -318,6 +318,5 @@ (put-sysprop 'nth 'C1CONDITIONAL 'co1nth) (put-sysprop 'nthcdr 'C1CONDITIONAL 'co1nthcdr) -(put-sysprop 'coerce 'C1CONDITIONAL 'co1coerce) (put-sysprop 'cons 'C1CONDITIONAL 'co1cons) (put-sysprop 'ldb 'C1CONDITIONAL 'co1ldb) diff --git a/src/cmp/cmpopt.lsp b/src/cmp/cmpopt.lsp index 0e0c567c8..de425b844 100644 --- a/src/cmp/cmpopt.lsp +++ b/src/cmp/cmpopt.lsp @@ -226,7 +226,7 @@ (cmperror "Cannot COERCE an expression to an empty type.")) ;; ;; No optimizations that take up too much space unless requested. - ((policy-inline-type-checks) + ((not (policy-inline-type-checks)) form) ;; ;; Search for a simple template above, replacing X by the value. @@ -265,7 +265,8 @@ (si::closest-sequence-type type) (if (eq elt-type 'list) `(si::coerce-to-list ,value) - `(si::coerce-to-vector ,value ',elt-type ',length)))) + `(si::coerce-to-vector ,value ',elt-type ',length + ,(and (subtypep type 'simple-array) t))))) ;; ;; There are no other atomic types to optimize ((atom type) diff --git a/src/lsp/seq.lsp b/src/lsp/seq.lsp index 66e52d353..6ba7b0f98 100644 --- a/src/lsp/seq.lsp +++ b/src/lsp/seq.lsp @@ -160,9 +160,10 @@ default value of INITIAL-ELEMENT depends on TYPE." ((null it) (nreverse output)) (push (seq-iterator-ref object it) output)))) -(defun coerce-to-vector (object elt-type length) +(defun coerce-to-vector (object elt-type length simple-array-p) (let ((output object)) (unless (and (vectorp object) + (or (null simple-array-p) (simple-array-p object)) (eq (array-element-type object) elt-type)) (let* ((final-length (if (eq length '*) (length object) length))) (setf output (make-vector elt-type final-length nil nil nil 0))