From 2a55488e7e0d7986d65cdb64d7523ffceb0471a1 Mon Sep 17 00:00:00 2001 From: jgarcia Date: Mon, 29 May 2006 12:36:36 +0000 Subject: [PATCH] Emit proper code for arrays that contain circular references --- src/clos/print.lsp | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/src/clos/print.lsp b/src/clos/print.lsp index da0575e6e..374e32514 100644 --- a/src/clos/print.lsp +++ b/src/clos/print.lsp @@ -77,12 +77,19 @@ printer and we should rather use MAKE-LOAD-FORM." (return-from make-load-form (maybe-quote object))) (typecase object (array - (values `(make-array ',(array-dimensions object) - :element-type ',(array-element-type object) - :adjustable ',(adjustable-array-p object) - :initial-contents ',(loop for i from 0 below (array-total-size object) - collect (row-major-aref object i))) - init)) + (let ((init-forms '())) + (values `(make-array ',(array-dimensions object) + :element-type ',(array-element-type object) + :adjustable ',(adjustable-array-p object) + :initial-contents + ',(loop for i from 0 below (array-total-size object) + collect (let ((x (row-major-aref object i))) + (if (need-to-make-load-form-p x) + (progn (push `(setf (row-major-aref ,object ,i) ,x) + init-forms) + 0) + x)))) + (and init-forms `(progn ,@init-forms))))) (cons (values `(cons ,(maybe-quote (car object)) nil) (and (rest object) `(rplacd ,(maybe-quote object) ,(maybe-quote (cdr object))))))