Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv7681

Modified Files: copy-array.lisp Log Message: Factored out part of COPY-ARRAY into its own function.

Date: Thu May 26 22:24:24 2005 Author: pscott

Index: cl-utilities/copy-array.lisp diff -u cl-utilities/copy-array.lisp:1.1.1.1 cl-utilities/copy-array.lisp:1.2 --- cl-utilities/copy-array.lisp:1.1.1.1 Mon May 9 23:26:29 2005 +++ cl-utilities/copy-array.lisp Thu May 26 22:24:24 2005 @@ -7,19 +7,23 @@ unless UNDISPLACE is non-NIL, in which case the contents of the array will be copied into a completely new, not displaced, array." (declare (type array array)) - (let ((copy - (apply #'make-array - (list* (array-dimensions array) - :element-type (array-element-type array) - :adjustable (adjustable-array-p array) - :fill-pointer (when (array-has-fill-pointer-p array) - (fill-pointer array)) - (multiple-value-bind (displacement offset) - (array-displacement array) - (when (and displacement (not undisplace)) - (list :displaced-to displacement - :displaced-index-offset offset))))))) + (let ((copy (%make-array-with-same-properties array undisplace))) (unless (array-displacement copy) (dotimes (n (array-total-size copy)) (setf (row-major-aref copy n) (row-major-aref array n)))) - copy)) \ No newline at end of file + copy)) + +(defun %make-array-with-same-properties (array undisplace) + "Make an array with the same properties (size, adjustability, etc.) +as another array, optionally undisplacing the array." + (apply #'make-array + (list* (array-dimensions array) + :element-type (array-element-type array) + :adjustable (adjustable-array-p array) + :fill-pointer (when (array-has-fill-pointer-p array) + (fill-pointer array)) + (multiple-value-bind (displacement offset) + (array-displacement array) + (when (and displacement (not undisplace)) + (list :displaced-to displacement + :displaced-index-offset offset)))))) \ No newline at end of file