From 2a61fbdd27d9a3ff4dea7b2f1f193668b13f2f1b Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Fri, 15 Feb 2008 22:33:10 +0100
Subject: Specialise PRINT-OBJECT for FOREIGN-STRUCT values.

darcs-hash:cbdd6159c27549dcc033b9bf38c0bf4fd8c51054
---
 Lisp/utilities.lisp | 20 +++++++++++++++-----
 1 file changed, 15 insertions(+), 5 deletions(-)

(limited to 'Lisp/utilities.lisp')

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")
-- 
cgit v1.2.3