X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdescribe.lisp;h=fc04552fad4340c193b90aa9c990f20fddc8a746;hb=0a82f2db352cc348d2107a882e50af222ff97ed3;hp=94afc2c71971457a23ba8e84a9556f20c67aaf43;hpb=a40c4adfd7837230109cdb1f054b44fe0b15371a;p=sbcl.git diff --git a/src/code/describe.lisp b/src/code/describe.lisp index 94afc2c..fc04552 100644 --- a/src/code/describe.lisp +++ b/src/code/describe.lisp @@ -11,9 +11,6 @@ ;;;; files for more information. (in-package "SB-IMPL") ;(SB-IMPL, not SB!IMPL, since we're built in warm load.) - -(declaim #.*optimize-byte-compilation*) - (defvar *describe-indentation-step* 3 #+sb-doc @@ -25,7 +22,6 @@ (defun describe (x &optional (stream-designator *standard-output*)) #+sb-doc "Print a description of the object X." - (declare #.*optimize-external-despite-byte-compilation*) (let ((stream (out-synonym-of stream-designator))) (pprint-logical-block (stream nil) (fresh-line stream) @@ -40,9 +36,10 @@ (defmethod describe-object ((x cons) s) (call-next-method) - (when (and (legal-function-name-p x) + (when (and (legal-fun-name-p x) (fboundp x)) - (format s "Its FDEFINITION is ~S.~@:_" (fdefinition x)) + (%describe-function (fdefinition x) s :function x) + ;;was: (format s "~@:_Its FDEFINITION is ~S.~@:_" (fdefinition x)) ;; TO DO: should check for SETF documentation. ;; TO DO: should make it clear whether the definition is a ;; DEFUN (SETF FOO) or DEFSETF FOO or what. @@ -113,8 +110,8 @@ ;;; up as a name. (In the case of anonymous closures and other ;;; things, it might not be.) TYPE-SPEC is the function type specifier ;;; extracted from the definition, or NIL if none. -(declaim (ftype (function (t stream t)) %describe-function-name)) -(defun %describe-function-name (name s type-spec) +(declaim (ftype (function (t stream t)) %describe-fun-name)) +(defun %describe-fun-name (name s type-spec) (when (and name (typep name '(or symbol cons))) (multiple-value-bind (type where) (if (or (symbolp name) (and (listp name) (eq (car name) 'setf))) @@ -130,7 +127,7 @@ (format s "~@:_It is currently declared ~(~A~);~ ~:[no~;~] expansion is available." - inlinep (info :function :inline-expansion name)))))) + inlinep (info :function :inline-expansion-designator name)))))) ;;; Print information from the debug-info about where CODE-OBJ was ;;; compiled from. @@ -161,14 +158,14 @@ ;;; the guts. (defun %describe-function-compiled (x s kind name) (declare (type stream s)) - ;; FIXME: The lowercaseness of %FUNCTION-ARGLIST results, and the + ;; FIXME: The lowercaseness of %SIMPLE-FUN-ARGLIST results, and the ;; non-sentenceness of the "Arguments" label, makes awkward output. ;; Better would be "Its arguments are: ~S" (with uppercase argument ;; names) when arguments are known, and otherwise "There is no ;; information available about its arguments." or "It has no - ;; arguments." (And why is %FUNCTION-ARGLIST a string instead of a + ;; arguments." (And why is %SIMPLE-FUN-ARGLIST a string instead of a ;; list of symbols anyway?) - (let ((args (%function-arglist x))) + (let ((args (%simple-fun-arglist x))) (format s "~@:_~@(~@[~A ~]arguments:~@:_~)" kind) (cond ((not args) (format s " There is no argument information available.")) @@ -179,23 +176,15 @@ (pprint-logical-block (s nil) (pprint-indent :current 2) (write-string args s))))) - (let ((name (or name (%function-name x)))) - (%describe-doc name s 'function kind) - (unless (eq kind :macro) - (%describe-function-name name s (%function-type x)))) - (%describe-compiled-from (sb-kernel:function-code-header x) s)) - -(defun %describe-function-byte-compiled (x s kind name) - (declare (type stream s)) - (let ((name (or name (sb-c::byte-function-name x)))) + (let ((name (or name (%simple-fun-name x)))) (%describe-doc name s 'function kind) (unless (eq kind :macro) - (%describe-function-name name s 'function))) - (%describe-compiled-from (sb-c::byte-function-component x) s)) + (%describe-fun-name name s (%simple-fun-type x)))) + (%describe-compiled-from (sb-kernel:fun-code-header x) s)) ;;; Describe a function with the specified kind and name. The latter ;;; arguments provide some information about where the function came -;;; from. Kind NIL means not from a name. +;;; from. KIND=NIL means not from a name. (defun %describe-function (x s &optional (kind nil) name) (declare (type function x)) (declare (type stream s)) @@ -206,28 +195,17 @@ (:function (format s "Function: ~S" x)) ((nil) (format s "~S is a function." x))) (case (get-type x) - (#.sb-vm:closure-header-type - (%describe-function-compiled (%closure-function x) s kind name) + (#.sb-vm:closure-header-widetag + (%describe-function-compiled (%closure-fun x) s kind name) (format s "~@:_Its closure environment is:") (pprint-logical-block (s nil) (pprint-indent :current 8) (dotimes (i (- (get-closure-length x) (1- sb-vm:closure-info-offset))) (format s "~@:_~S: ~S" i (%closure-index-ref x i))))) - ((#.sb-vm:function-header-type #.sb-vm:closure-function-header-type) + ((#.sb-vm:simple-fun-header-widetag #.sb-vm:closure-fun-header-widetag) (%describe-function-compiled x s kind name)) - (#.sb-vm:funcallable-instance-header-type + (#.sb-vm:funcallable-instance-header-widetag (typecase x - (sb-kernel:byte-function - (%describe-function-byte-compiled x s kind name)) - (sb-kernel:byte-closure - (%describe-function-byte-compiled (byte-closure-function x) - s kind name) - (format s "~@:_Its closure environment is:") - (pprint-logical-block (s nil) - (pprint-indent :current 8) - (let ((data (byte-closure-data x))) - (dotimes (i (length data)) - (format s "~@:_~S: ~S" i (svref data i)))))) (standard-generic-function ;; There should be a special method for this case; we'll ;; delegate to that.