1 files changed, 24 insertions(+), 20 deletions(-)

M main.lisp

@@ 65,26 65,30 @@
   (:documentation "A mixin for printing object graphs READably."))
 
 (defun/typed print-data-class-object-readably ((object data-class) (stream stream)) null
-  (let ((class (class-of object)))
-    (pprint-logical-block (stream nil)
-      (format stream "#.(~s '~s " 'make-instance (class-name class))
-      (pprint-indent :block 4 stream)
-      (pprint-newline :fill stream)
-      (pprint-logical-block (stream nil)
-        (iter
-          (for slot in (class-slots class))
-          (unless (slot-boundp-using-class class object slot)
-            (next-iteration))
-          (unless (first-time-p)
-            (write-char #\Space stream)   
-            (pprint-newline :linear stream))
-          (format stream "~s " (or (first (slot-definition-initargs slot))
-                                   (slot-definition-name slot)))
-          (let ((value (slot-value-using-class class object slot)))
-            (unless (typep value 'self-evaluating)
-              (write-char #\' stream))
-            (write value :stream stream))))
-      (write-char #\) stream)))
+  (let* ((class (class-of object))
+         (slots (class-slots class)))
+    (flet ((boundp* (slot) (slot-boundp-using-class class object slot)))
+      (if (notany #'boundp* slots)
+          (format stream "#.(~s '~s)" 'make-instance (class-name class))
+          (pprint-logical-block (stream nil)
+            (format stream "#.(~s '~s " 'make-instance (class-name class))
+            (pprint-indent :block 4 stream)
+            (pprint-newline :fill stream)
+            (pprint-logical-block (stream nil)
+              (iter
+                (for slot in slots)
+                (unless (boundp* slot)
+                  (next-iteration))
+                (unless (first-time-p)
+                  (write-char #\Space stream)   
+                  (pprint-newline :linear stream))
+                (format stream "~s " (or (first (slot-definition-initargs slot))
+                                         (slot-definition-name slot)))
+                (let ((value (slot-value-using-class class object slot)))
+                  (unless (typep value 'self-evaluating)
+                    (write-char #\' stream))
+                  (write value :stream stream))))
+            (write-char #\) stream)))))
   nil)
 
 (defgeneric print-object-pretty (object stream)