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

be more consistent w.r.t *print-level* when printing structures

Browse source 
Print empty structures without slots as "#" when *print-level* is
    0 (same as non-empty structures) and decrement *print-level* by 1
    for printing of structure elements.
    Fixes #454.
This commit is contained in:
Marius Gerbershagen 2019-01-30 21:00:59 +01:00
parent 0ad38e2a3d
commit 689ac03a85
1 changed files with 21 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

40
src/clos/builtin.lsp
View file

@ -93,8 +93,7 @@
(let* ((class (si:instance-class obj))
(slotds (class-slots class)))
(declare (:read-only class))
(when (and slotds
;; *p-readably* effectively disables *p-level*
(when (and ;; *p-readably* effectively disables *p-level*
(not *print-readably*)
*print-level*
(zerop *print-level*))
@ -102,22 +101,25 @@
(return-from print-object obj))
(write-string "#S(" stream)
(prin1 (class-name class) stream)
(do ((scan slotds (cdr scan))
(i 0 (1+ i))
(limit (or *print-length* most-positive-fixnum))
(sv))
((null scan))
(declare (fixnum i))
(when (>= i limit)
(write-string " ..." stream)
(return))
(setq sv (si:instance-ref obj i))
(write-string " " stream)
;; 2.4.8.13 Sharpsign S: slots are keywords
(prin1 (intern (symbol-name (slot-definition-name (car scan)))
(find-package 'keyword))
stream)
(write-string " " stream)
(prin1 sv stream))
(let ((*print-level* (if (and *print-level* (>= *print-level* 1))
(1- *print-level*)
*print-level*)))
(do ((scan slotds (cdr scan))
(i 0 (1+ i))
(limit (or *print-length* most-positive-fixnum))
(sv))
((null scan))
(declare (fixnum i))
(when (>= i limit)
(write-string " ..." stream)
(return))
(setq sv (si:instance-ref obj i))
(write-string " " stream)
;; 2.4.8.13 Sharpsign S: slots are keywords
(prin1 (intern (symbol-name (slot-definition-name (car scan)))
(find-package 'keyword))
stream)
(write-string " " stream)
(prin1 sv stream)))
(write-string ")" stream)
obj))