(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):
- Why the SHALLOW-prefix? COPY-SEQ, COPY-LIST, COPY-STRUCTURE are all shallow as well. COPY-ARRAY would imo be clear enough and less ugly as well.
- There's a portable trick to do this without iteration. If don't know it and you like puzzles, try to figure it out from the Array chapter in CLHS, and read how once you fail.