X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fcmucl-compat.lisp;h=9ea2561c9b2788bf1a128d9ee3fee3b5289c646a;hp=9853ab8b8f6e68a76feee9f9fbddd018f02dd417;hb=d2d49ab13c98bc7a1819a0fd3968268a5567bdc3;hpb=f10c3dcbe75b5532d6646e24ecd25f5651a0c3a9 diff --git a/sql/cmucl-compat.lisp b/sql/cmucl-compat.lisp index 9853ab8..9ea2561 100644 --- a/sql/cmucl-compat.lisp +++ b/sql/cmucl-compat.lisp @@ -7,9 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id$ -;;;; -;;;; This file, part of CLSQL, is Copyright (c) 2002-2006 by Kevin M. Rosenberg +;;;; This file, part of CLSQL, is Copyright (c) 2002-2010 by Kevin M. Rosenberg ;;;; ;;;; CLSQL users are granted the rights to distribute and use this software ;;;; as governed by the terms of the Lisp Lesser GNU Public License @@ -54,16 +52,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))) )))