X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fcmucl-compat.lisp;h=59443639aec85464bb7d55aa5f4bafb909351752;hp=9853ab8b8f6e68a76feee9f9fbddd018f02dd417;hb=refs%2Ftags%2Fv3.8.6;hpb=215ec41559dda52d46539d48a0aa390811c2423c diff --git a/sql/cmucl-compat.lisp b/sql/cmucl-compat.lisp index 9853ab8..5944363 100644 --- a/sql/cmucl-compat.lisp +++ b/sql/cmucl-compat.lisp @@ -54,16 +54,16 @@ Needs to be a macro to overwrite value of VEC." (adjust-array ,vec ,len)) ((typep ,vec 'simple-array) (let ((,new-vec (make-array ,len :element-type - (array-element-type ,vec)))) - (check-type ,len fixnum) - (locally (declare (optimize (speed 3) (safety 0) (space 0)) ) - (dotimes (i ,len) - (declare (fixnum i)) - (setf (aref ,new-vec i) (aref ,vec i)))) - (setq ,vec ,new-vec))) + (array-element-type ,vec)))) + (check-type ,len fixnum) + (locally (declare (optimize (speed 3) (safety 0) (space 0)) ) + (dotimes (i ,len) + (declare (fixnum i)) + (setf (aref ,new-vec i) (aref ,vec i)))) + (setq ,vec ,new-vec))) ((typep ,vec 'vector) - (setf (fill-pointer ,vec) ,len) - ,vec) + (setf (fill-pointer ,vec) ,len) + ,vec) (t (error "Unable to shrink vector ~S which is type-of ~S" ,vec (type-of ,vec))) )))