diff --git a/code/describe.lisp b/code/describe.lisp index e69d586474143089362941a55b2dc247954c8f32..57351f119eb105b61bae94d51ef07abec1c63ff7 100644 --- a/code/describe.lisp +++ b/code/describe.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/describe.lisp,v 1.23 1993/02/26 08:25:09 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/describe.lisp,v 1.24 1993/05/29 07:00:59 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -139,12 +139,12 @@ (defun default-describe (x) (format t "~&~S is a ~S." x (type-of x))) -(defun describe-instance (x) +(defun describe-instance (x &optional (kind :structure)) (cond ((and (fboundp 'pcl::std-instance-p) (pcl::std-instance-p x)) (pcl::describe-object x *standard-output*)) (t - (format t "~&~S is a structure of type ~A." x (type-of x)) + (format t "~&~S is a ~(~A~) of type ~A." x kind (type-of x)) (dolist (slot (cddr (inspect::describe-parts x))) (format t "~%~A: ~S." (car slot) (cdr slot)))))) @@ -317,6 +317,10 @@ (print-compiled-from x)) +(defun describe-funcallabe-instance (fin) + (describe-instance fin :funcallable-instance)) + + ;;; DESCRIBE-FUNCTION -- Internal ;;; ;;; Describe a function with the specified kind and name. The latter @@ -344,7 +348,7 @@ ((#.vm:function-header-type #.vm:closure-function-header-type) (describe-function-compiled x kind name)) (#.vm:funcallable-instance-header-type - (pcl::describe-object x *standard-output*)) + (describe-funcallabe-instance x)) (t (format t "~&It is an unknown type of function.")))) diff --git a/code/tty-inspect.lisp b/code/tty-inspect.lisp index 93e4926c299aa9bfe7e133d95a98fabf95e83347..719e7d1d884bd0fd17c0946059c837d5fe5e6c36 100644 --- a/code/tty-inspect.lisp +++ b/code/tty-inspect.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/tty-inspect.lisp,v 1.12 1993/02/26 08:26:20 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/tty-inspect.lisp,v 1.13 1993/05/29 07:01:10 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -149,8 +149,11 @@ (defun describe-parts (object) (typecase object (symbol (describe-symbol-parts object)) - (instance (describe-instance-parts object)) - (function (describe-function-parts object)) + (instance (describe-instance-parts object :structure)) + (function + (if (kernel:funcallable-instance-p object) + (describe-instance-parts object :funcallabe-instance) + (describe-function-parts object))) (vector (describe-vector-parts object)) (array (describe-array-parts object)) (cons (describe-cons-parts object)) @@ -167,11 +170,10 @@ (cons "Plist" (symbol-plist object)) (cons "Package" (symbol-package object)))) -(defun describe-instance-parts (object) - (let ((dd-slots - (dd-slots (layout-info (%instance-layout object)))) +(defun describe-instance-parts (object kind) + (let ((dd-slots (dd-slots (layout-info (kernel:layout-of object)))) (parts-list ())) - (push (format nil "~s is a structure.~%" object) parts-list) + (push (format nil "~s is a ~(~A~).~%" object kind) parts-list) (push t parts-list) (dolist (dd-slot dd-slots (nreverse parts-list)) (push (cons (dsd-%name dd-slot)