diff options
| author | cjl <empty> | 1990-05-01 21:37:53 +0000 |
|---|---|---|
| committer | cjl <empty> | 1990-05-01 21:37:53 +0000 |
| commit | fc2267d7741f89aa00ec80b89b8f37141da0a12f (patch) | |
| tree | 6a1f0a8e1f5d2dd01bf3cd27178bc346d45cbc0d | |
| parent | fbbe6026b1b4da2b0a9933ca07d2df2ba5dcb426 (diff) | |
handle pcl lossage wrt type-of in print-unreadable-objectR4_2
| -rw-r--r-- | xc/unsupported/lib/CLX/depdefs.l | 14 |
1 files changed, 13 insertions, 1 deletions
diff --git a/xc/unsupported/lib/CLX/depdefs.l b/xc/unsupported/lib/CLX/depdefs.l index d62799a4e..1f86c22d6 100644 --- a/xc/unsupported/lib/CLX/depdefs.l +++ b/xc/unsupported/lib/CLX/depdefs.l @@ -609,7 +609,19 @@ #-(or ansi-common-lisp Genera) (defun print-unreadable-object-function (object stream type identity function) (princ "#<" stream) - (when type (prin1 (type-of object) stream)) + (when type + (let ((type (type-of object)) + (pcl-package (find-package 'pcl))) + ;; Handle pcl type-of lossage + (when (and pcl-package + (symbolp type) + (eq (symbol-package type) pcl-package) + (string-equal (symbol-name type) "STD-INSTANCE")) + (setq type + (funcall (intern (symbol-name 'class-name) pcl-package) + (funcall (intern (symbol-name 'class-of) pcl-package) + object)))) + (prin1 type stream))) (when (and type function) (princ " " stream)) (when function (funcall function)) (when (and (or type function) identity) (princ " " stream)) |