From 7703c71141ae111770f5304d931b67cb115a61a4 Mon Sep 17 00:00:00 2001
From: John Lorentzson <john_lorentzson@yahoo.com>
Date: Thu, 26 Jun 2025 12:44:43 +0200
Subject: [PATCH] Add tool for quickly defining common PRINT-OBJECT methods

---
 wip-duuqnd/user-side-compiler/package.lisp           |  5 +++++
 wip-duuqnd/user-side-compiler/toolkit.lisp           | 12 ++++++++++++
 wip-duuqnd/user-side-compiler/user-side-compiler.asd |  1 +
 3 files changed, 18 insertions(+)
 create mode 100644 wip-duuqnd/user-side-compiler/toolkit.lisp

diff --git a/wip-duuqnd/user-side-compiler/package.lisp b/wip-duuqnd/user-side-compiler/package.lisp
index a8886f7..57b6aa4 100644
--- a/wip-duuqnd/user-side-compiler/package.lisp
+++ b/wip-duuqnd/user-side-compiler/package.lisp
@@ -1,5 +1,10 @@
 (cl:in-package #:cl-user)
 
+(defpackage #:user-side-compiler/toolkit
+  (:use #:cl)
+  (:export #:define-simple-print-object))
+
 (defpackage #:user-side-compiler
   (:nicknames #:usc)
+  (:local-nicknames (#:tlk #:user-side-compiler/toolkit))
   (:use #:cl))
diff --git a/wip-duuqnd/user-side-compiler/toolkit.lisp b/wip-duuqnd/user-side-compiler/toolkit.lisp
new file mode 100644
index 0000000..6ce0e7a
--- /dev/null
+++ b/wip-duuqnd/user-side-compiler/toolkit.lisp
@@ -0,0 +1,12 @@
+(in-package #:user-side-compiler/toolkit)
+
+(defmacro define-simple-print-object ((class &rest slot-names)
+                                      &key (format-string "~A")
+                                        (type t) (identity t))
+  (when (some #'listp slot-names)
+    (error "SLOT-NAMES must be a list of symbols, they may not be quoted."))
+  `(defmethod print-object ((object ,class) stream)
+     (print-unreadable-object (object stream :type ,type :identity ,identity)
+       (when (and ,@(loop :for s :in slot-names :collect `(slot-boundp object ',s)))
+         (format stream ,format-string ,@(loop :for s :in slot-names
+                                               :collect `(slot-value object ',s)))))))
diff --git a/wip-duuqnd/user-side-compiler/user-side-compiler.asd b/wip-duuqnd/user-side-compiler/user-side-compiler.asd
index 87cee28..701d6a3 100644
--- a/wip-duuqnd/user-side-compiler/user-side-compiler.asd
+++ b/wip-duuqnd/user-side-compiler/user-side-compiler.asd
@@ -5,6 +5,7 @@
   :depends-on (#:closer-mop)
   :components
   ((:file "package")
+   (:file "toolkit")
    (:file "transform")
    (:file "reference")
    (:file "symbol-table")