X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fdescribe.lisp;h=4b1aa1d857dd304d44e495ceaf8a9c199c327bba;hb=90ca09b75fbc3b63b2f7d09c67b04b866dd783f6;hp=c2ce9dc81f99b67674403e8643275f0877e7e4b0;hpb=f143939b1dbaf38ebd4f92c851fbc4ecddf37af1;p=sbcl.git diff --git a/src/code/describe.lisp b/src/code/describe.lisp index c2ce9dc..4b1aa1d 100644 --- a/src/code/describe.lisp +++ b/src/code/describe.lisp @@ -36,7 +36,7 @@ (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) ;;was: (format s "~@:_Its FDEFINITION is ~S.~@:_" (fdefinition x)) @@ -110,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))) @@ -127,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. @@ -179,7 +179,7 @@ (let ((name (or name (%simple-fun-name x)))) (%describe-doc name s 'function kind) (unless (eq kind :macro) - (%describe-function-name name s (%simple-fun-type x)))) + (%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 @@ -194,17 +194,20 @@ (: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 + (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-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:simple-fun-header-type #.sb-vm:closure-fun-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 (standard-generic-function ;; There should be a special method for this case; we'll