Merge pull request #214 from lokedhs/master

Added the useful macro PRINT-UNREADABLE-SAFELY
illacceptanything · Apr 10, 2015 · 43d0dec · 43d0dec
2 parents 53f144a + 61dbcc8
commit 43d0dec
Showing 1 changed file with 19 additions and 0 deletions.
diff --git a/cl/misc.lisp b/cl/misc.lisp
@@ -0,0 +1,19 @@
+;;;
+;;;  Useful function that ensures that unbound slots don't cause a
+;;;  recursive error when trying to print a stack trace.
+;;;
+
+(defmacro print-unreadable-safely ((&rest slots) object stream &body body)
+  "A version of PRINT-UNREADABLE-OBJECT and WITH-SLOTS that is safe to use with unbound slots"
+  (let ((object-copy (gensym "OBJECT"))
+        (stream-copy (gensym "STREAM")))
+    `(let ((,object-copy ,object)
+           (,stream-copy ,stream))
+       (symbol-macrolet ,(mapcar #'(lambda (slot-name)
+                                     `(,slot-name (if (and (slot-exists-p ,object-copy ',slot-name)
+                                                           (slot-boundp ,object-copy ',slot-name))
+                                                      (slot-value ,object-copy ',slot-name)
+                                                      :not-bound)))
+                                 slots)
+         (print-unreadable-object (,object-copy ,stream-copy :type t :identity nil)
+           ,@body)))))