From 689ac03a85bae29a0053d36c7793a2a44009d035 Mon Sep 17 00:00:00 2001
From: Marius Gerbershagen <marius.gerbershagen@gmail.com>
Date: Wed, 30 Jan 2019 21:00:59 +0100
Subject: [PATCH] be more consistent w.r.t *print-level* when printing
 structures

    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.
---
 src/clos/builtin.lsp | 40 +++++++++++++++++++++-------------------
 1 file changed, 21 insertions(+), 19 deletions(-)

diff --git a/src/clos/builtin.lsp b/src/clos/builtin.lsp
index f2123232f..7aa21bc91 100644
--- a/src/clos/builtin.lsp
+++ b/src/clos/builtin.lsp
@@ -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))