From 2a61fbdd27d9a3ff4dea7b2f1f193668b13f2f1b Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Fri, 15 Feb 2008 22:33:10 +0100 Subject: Specialise PRINT-OBJECT for FOREIGN-STRUCT values. darcs-hash:cbdd6159c27549dcc033b9bf38c0bf4fd8c51054 --- Lisp/data-types.lisp | 1 + Lisp/utilities.lisp | 20 +++++++++++++++----- 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") -- cgit v1.2.3