+
+(defvar *debug-name-level* 6)
+
+(defun debug-name (type thing)
+ (labels ((walk (x level)
+ (if (> *debug-name-level* (incf level))
+ (typecase x
+ (cons
+ (cons (walk (car x) level) (walk (cdr x) level)))
+ ((or symbol number string)
+ x)
+ (t
+ (list 'of-type (type-of x))))
+ "#<...>")))
+ ;; FIXME: It might be nice to put markers in the tree instead of
+ ;; this #<...> business, so that they would evantually be printed
+ ;; without the quotes.
+ (let ((name (list type (walk thing 0))))
+ (when (legal-fun-name-p name)
+ (bug "~S is a legal function name, and cannot be used as a ~
+ debug name." name))
+ name)))