X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdescribe.lisp;h=35971bc5bd863b5282ee8b6b25dcb56bfcc334ce;hb=f6a2be77637d025bfded9430f02863c28f74f77a;hp=c23bb7829baf8dc3aa82b912cfe216bb337a4720;hpb=416152f084604094445a758ff399871132dff2bd;p=sbcl.git diff --git a/src/code/describe.lisp b/src/code/describe.lisp index c23bb78..35971bc 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,9 @@ (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)) - (%describe-function (fdefinition x) s :function x) + (%describe-fun (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 @@ -114,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))) @@ -131,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. @@ -160,16 +156,16 @@ ;;; Describe a compiled function. The closure case calls us to print ;;; the guts. -(defun %describe-function-compiled (x s kind name) +(defun %describe-fun-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.")) @@ -180,27 +176,16 @@ (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)) - -;;; FIXME: byte compiler to go away completely -#| -(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. -(defun %describe-function (x s &optional (kind nil) name) +;;; from. KIND=NIL means not from a name. +(defun %describe-fun (x s &optional (kind nil) name) (declare (type function x)) (declare (type stream s)) (declare (type (member :macro :function nil) kind)) @@ -209,32 +194,21 @@ (:macro (format s "Macro-function: ~S" x)) (: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) + (format s "~@:_Its associated name (as in ~S) is ~S." + 'function-lambda-expression + (%fun-name x)) + (case (widetag-of x) + (#.sb-vm:closure-header-widetag + (%describe-fun-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) - (%describe-function-compiled x s kind name)) - (#.sb-vm:funcallable-instance-header-type + ((#.sb-vm:simple-fun-header-widetag #.sb-vm:closure-fun-header-widetag) + (%describe-fun-compiled x s kind name)) + (#.sb-vm:funcallable-instance-header-widetag (typecase x - ;; FIXME: byte compiler to go away completely - #| - (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. @@ -245,7 +219,7 @@ (format s "~@:_It is an unknown type of function.")))) (defmethod describe-object ((x function) s) - (%describe-function x s)) + (%describe-fun x s)) (defmethod describe-object ((x symbol) s) (declare (type stream s)) @@ -296,11 +270,11 @@ ;; Describe the function cell. (cond ((macro-function x) - (%describe-function (macro-function x) s :macro x)) + (%describe-fun (macro-function x) s :macro x)) ((special-operator-p x) (%describe-doc x s 'function "Special form")) ((fboundp x) - (%describe-function (fdefinition x) s :function x))) + (%describe-fun (fdefinition x) s :function x))) ;; FIXME: Print out other stuff from the INFO database: ;; * Does it name a type?