Commit 75f9136a authored by Svante Carl v. Erichsen's avatar Svante Carl v. Erichsen Committed by Nikodemus Siivola

improved COPY-ARRAY

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