From 9d936beb41e1ed90c4a4b4ea2eaa620eac3223f7 Mon Sep 17 00:00:00 2001 From: jjgarcia Date: Fri, 10 May 2002 07:37:25 +0000 Subject: [PATCH] When displacing array A to B, ADJUST-ARRAY should not copy data from A to B. --- src/lsp/arraylib.lsp | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/lsp/arraylib.lsp b/src/lsp/arraylib.lsp index a21bf12a7..b904aaa15 100644 --- a/src/lsp/arraylib.lsp +++ b/src/lsp/arraylib.lsp @@ -351,13 +351,12 @@ adjustable array." (push :element-type r))) (let ((x (apply #'make-array new-dimensions :adjustable t r))) (declare (array x)) - (do ((cursor (make-list (length new-dimensions) :initial-element 0))) - (nil) - (when (apply #'array-in-bounds-p array cursor) - (apply #'aset (apply #'aref array cursor) - x - cursor)) - (when (increment-cursor cursor new-dimensions) - (return nil))) + (unless displaced-to + (do ((cursor (make-list (length new-dimensions) :initial-element 0))) + (nil) + (when (apply #'array-in-bounds-p array cursor) + (apply #'aset (apply #'aref array cursor) x cursor)) + (when (increment-cursor cursor new-dimensions) + (return nil)))) (sys:replace-array array x) ))