Specialise PRINT-OBJECT for FOREIGN-STRUCT values.

darcs-hash:cbdd6159c27549dcc033b9bf38c0bf4fd8c51054

2 files changed, 16 insertions, 5 deletions

diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp
index 5d8c22b..cfbfcfb 100644
--- a/Lisp/data-types.lisp
+++ b/Lisp/data-types.lisp
@@ -302,6 +302,7 @@ an __exception__, you can simply send it the `self' message.
       (let ((new-wrapper (make-instance (ecase (typespec-primary-type typespec)
                                           (struct 'tagged-struct)
                                           (union 'tagged-union))
+                            :name (third typespec)
                             :typespec typespec
                             :pointer pointer
                             :lisp-managed-cell managedp-cell)))
diff --git a/Lisp/utilities.lisp b/Lisp/utilities.lisp
index 8b0ac5c..384c7e2 100644
--- a/Lisp/utilities.lisp
+++ b/Lisp/utilities.lisp
@@ -275,11 +275,21 @@ invocations will return numbers.)
 
 (defmethod print-object ((exception exception) stream)
   (print-unreadable-object (exception stream)
-    (format stream "~S ~A {~X}"
-            (type-of exception)
-            (primitive-invoke (primitive-invoke exception "name" 'id)
-                              "UTF8String" :string)
-            (primitive-invoke exception "hash" :unsigned-int))))
+    (with-slots (pointer) exception
+      (format stream "~S ~A {~X}"
+              (type-of exception)
+              (primitive-invoke (primitive-invoke exception "name" 'id)
+                                "UTF8String" :string)
+              (cffi:pointer-address pointer)))))
+
+
+(defmethod print-object ((struct foreign-struct) stream)
+  (print-unreadable-object (struct stream)
+    (with-slots (pointer name) struct
+      (format stream "~S of type ~A {~X}"
+              (type-of struct)
+              name
+              (cffi:pointer-address pointer)))))
 
 
 ;;; (@* "Structure and Union Definition")