(SHALLOW-COPY-ARRAY) is a member of the Common Lisp Utilities family of programs.
(defun shallow-copy-array (array &key (undisplace-array nil))
"Shallow copies the contents of any array into another array with
equivalent properties. If array is displaced, then this function
will normally create another displaced array with similar properties,
unless UNDISPLACE-ARRAY is non-NIL, in which case the contents of the
array will be copied into a completely new, not displaced, array."
(check-type array array)
(multiple-value-bind (displaced-to displaced-index-offset)
(array-displacement array)
(let ((dimensions (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))))
(when undisplace-array
(setf displaced-to nil))
(let ((new-array
(apply #'make-array
(list* dimensions
:element-type element-type
:adjustable adjustable
:fill-pointer fill-pointer
:displaced-to displaced-to
(if displaced-to
(list :displaced-index-offset
displaced-index-offset)
nil)))))
(unless displaced-to
(dotimes (i (array-total-size array))
(setf (row-major-aref new-array i)
(row-major-aref array i))))
new-array))))
This is quite similar to a copy-array I wrote recently. I find mine a bit easier to read, but on the other hand I am new at lisp; Do you see any problems with the following?
(defun copy-array (array &key (undisplace nil))
"Performs a shallow copy of array. If array is displaced,
the copy is also, unless undisplace is non-nil."
(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)))))))
(unless (array-displacement copy)
(dotimes (n (array-total-size copy))
(setf (row-major-aref copy n) (row-major-aref array n))))
copy))
Looks almost exactly the same, except that I explicitly bound all the values in a let first.
Two belated points (Nikodemus Siivola):
This page is linked from: Common Lisp Utilities copy-array
CLiki pages can be edited by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively