diff --git a/pcl/env.lisp b/pcl/env.lisp index 8538ff9e7712523ab606814a5ed4c51ca24ba297..861d72c256e4323da010d90016bce4372f37b0f7 100644 --- a/pcl/env.lisp +++ b/pcl/env.lisp @@ -100,8 +100,10 @@ (defgeneric describe-object (object stream)) +#-cmu (defvar *old-describe* ()) +#-cmu (eval-when (load) (unless *old-describe* (setq *old-describe* (symbol-function 'describe))) (setf (symbol-function 'describe) @@ -117,8 +119,11 @@ (values)))) (defmethod describe-object (object stream) + #-cmu (let ((*standard-output* stream)) - (funcall *old-describe* object))) + (funcall *old-describe* object)) + #+cmu + (describe object stream)) (defmethod describe-object ((object standard-object) stream) (let* ((class (class-of object)) @@ -169,6 +174,19 @@ (slotd-allocation slotd)))) (values)))) +#+cmu +(defmethod describe-object ((fun standard-generic-function) stream) + (format stream "~A is a generic function.~%" fun) + (format stream "Its arguments are:~% ~S~%" + (generic-function-pretty-arglist fun)) + (format stream "Its methods are:") + (dolist (meth (generic-function-methods fun)) + (format stream "~2%**** ~{~S ~}~:S =>~%" + (method-qualifiers meth) + (unparse-specializers meth)) + (describe-object (method-function meth) stream))) + + (defmethod slots-to-inspect ((class std-class) (object standard-object)) (class-slots class))