mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-02 15:40:55 -08:00
Code Issues Projects Releases Packages Wiki Activity

Emit proper code for arrays that contain circular references

Browse source
This commit is contained in:
jgarcia 2006-05-29 12:36:36 +00:00
parent 20ab0394db
commit 2a55488e7e
1 changed files with 13 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

19
src/clos/print.lsp
View file

@ -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))))))