Add tool for quickly defining common PRINT-OBJECT methods

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))

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)))))))

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")