mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-24 05:21:20 -08:00
Code Issues Projects Releases Packages Wiki Activity

pretty-printer: fix *print-circle* for arrays and vectors

Browse source 
The previous implementation did not respect *print-circle*.
Fixes #476.
This commit is contained in:
Marius Gerbershagen 2019-08-18 19:34:22 +02:00
parent 693ce14130
commit 31f079eb80
1 changed files with 26 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

44
src/lsp/pprint.lsp
View file

@ -1171,13 +1171,16 @@
(pprint-multi-dim-array stream array))))
(defun pprint-vector (stream vector)
(pprint-logical-block (stream nil :prefix "#(" :suffix ")")
(dotimes (i (length vector))
(unless (zerop i)
(write-char #\space stream)
(pprint-newline :fill stream))
(pprint-pop)
(write-object (aref vector i) stream))))
(write-object-with-circle
vector stream
#'(lambda (vector stream)
(pprint-logical-block (stream nil :prefix "#(" :suffix ")")
(dotimes (i (length vector))
(unless (zerop i)
(write-char #\space stream)
(pprint-newline :fill stream))
(pprint-pop)
(write-object (aref vector i) stream))))))
(defun pprint-array-contents (stream array)
(declare (si::c-local)
@ -1206,20 +1209,25 @@
(defun pprint-multi-dim-array (stream array)
(declare (si::c-local))
(funcall (formatter "#~DA") stream (array-rank array))
(pprint-array-contents stream array))
(write-object-with-circle
array stream
#'(lambda (array stream)
(funcall (formatter "#~DA") stream (array-rank array))
(pprint-array-contents stream array))))
(defun pprint-raw-array (stream array)
(declare (si::c-local))
(write-string "#A" stream)
(pprint-logical-block (stream nil :prefix "(" :suffix ")")
(write-object (array-element-type array) stream)
(write-char #\Space stream)
(pprint-newline :fill stream)
(write-object (array-dimensions array) stream)
(write-char #\Space stream)
(pprint-newline :fill stream)
(pprint-array-contents stream array)))
(write-object-with-circle
array stream
#'(lambda (array stream)
(pprint-logical-block (stream nil :prefix "#A(" :suffix ")")
(write-object (array-element-type array) stream)
(write-char #\Space stream)
(pprint-newline :fill stream)
(write-object (array-dimensions array) stream)
(write-char #\Space stream)
(pprint-newline :fill stream)
(pprint-array-contents stream array)))))
(defun pprint-lambda-list (stream lambda-list &rest noise)
(declare (ignore noise))