Skip to content
Snippets Groups Projects
Commit 75f9136a authored by Svante Carl v. Erichsen's avatar Svante Carl v. Erichsen Committed by Nikodemus Siivola
Browse files

improved COPY-ARRAY

  No need to depend on the vagaries of ADJUST-ARRAY.
parent cd158549
No related branches found
No related tags found
No related merge requests found
(in-package :alexandria)
(defun copy-array (array &key
(element-type (array-element-type array))
(fill-pointer (and (array-has-fill-pointer-p array)
(fill-pointer array)))
(adjustable (adjustable-array-p array)))
(defun copy-array (array &key (element-type (array-element-type array))
(fill-pointer (and (array-has-fill-pointer-p array)
(fill-pointer array)))
(adjustable (adjustable-array-p array)))
"Returns an undisplaced copy of ARRAY, with same fill-pointer and
adjustability (if any) as the original, unless overridden by the keyword
arguments. Performance depends on efficiency of general ADJUST-ARRAY in the
host lisp -- for most cases a special purpose copying function is likely to
perform better."
(let ((dims (array-dimensions array)))
;; Dictionary entry for ADJUST-ARRAY requires adjusting a
;; displaced array to a non-displaced one to make a copy.
(adjust-array
(make-array dims
:element-type element-type :fill-pointer fill-pointer
:adjustable adjustable :displaced-to array)
dims)))
arguments."
(let* ((dimensions (array-dimensions array))
(new-array (make-array dimensions
:element-type element-type
:adjustable adjustable
:fill-pointer fill-pointer)))
(dotimes (i (array-total-size array))
(setf (row-major-aref new-array i)
(row-major-aref array i)))
new-array))
......@@ -29,6 +29,24 @@
(eql (fill-pointer orig) (fill-pointer copy)))))
nil t t t)
(deftest copy-array.3
(let* ((orig (vector 1 2 3))
(copy (copy-array orig)))
(typep copy 'simple-array))
t)
(deftest copy-array.4
(let ((orig (make-array 21
:adjustable t
:fill-pointer 0)))
(dotimes (n 42)
(vector-push-extend n orig))
(let ((copy (copy-array orig
:adjustable nil
:fill-pointer nil)))
(typep copy 'simple-array)))
t)
(deftest array-index.1
(typep 0 'array-index)
t)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment