X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdescribe.lisp;h=1d064b380a0b060607f029e31a30faca54aafcbd;hb=4cf50b1896b25f5337e7c258b0b560da00d47993;hp=8a97208c81f2cb1684bb6f54b7f55b0697c905a1;hpb=1ff04b3ba4e6f3a0fc6ceea524e98720ecea7888;p=sbcl.git diff --git a/src/code/describe.lisp b/src/code/describe.lisp index 8a97208..1d064b3 100644 --- a/src/code/describe.lisp +++ b/src/code/describe.lisp @@ -11,6 +11,9 @@ ;;;; files for more information. (in-package "SB-IMPL") + +(declaim #.*optimize-byte-compilation*) + (defvar *describe-indentation-step* 3 #+sb-doc @@ -22,10 +25,12 @@ (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))) - #+nil (fresh-line stream) (pprint-logical-block (stream nil) - (describe-object x stream))) + (fresh-line stream) + (describe-object x stream) + (fresh-line stream))) (values)) ;;;; miscellaneous DESCRIBE-OBJECT methods @@ -94,7 +99,7 @@ ;;; Print the specified kind of documentation about the given NAME. If ;;; NAME is null, or not a valid name, then don't print anything. -(declaim (ftype (function (symbol stream t t) (values)) %describe-doc)) +(declaim (ftype (function (t stream t t) (values)) %describe-doc)) (defun %describe-doc (name s kind kind-doc) (when (and name (typep name '(or symbol cons))) (let ((doc (fdocumentation name kind))) @@ -104,24 +109,28 @@ (values)) ;;; Describe various stuff about the functional semantics attached to -;;; the specified Name. Type-Spec is the function type specifier +;;; the specified NAME, if NAME is the kind of thing you can look +;;; 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 ((or symbol cons) stream t)) %describe-function-name)) +(declaim (ftype (function (t stream t)) %describe-function-name)) (defun %describe-function-name (name s type-spec) - (multiple-value-bind (type where) - (if (or (symbolp name) (and (listp name) (eq (car name) 'setf))) - (values (type-specifier (info :function :type name)) - (info :function :where-from name)) - (values type-spec :defined)) - (when (consp type) - (format s "~@:_Its ~(~A~) argument types are:~@:_ ~S" - where (second type)) - (format s "~@:_Its result type is:~@:_ ~S" (third type)))) - (let ((inlinep (info :function :inlinep name))) - (when inlinep - (format s "~@:_It is currently declared ~(~A~);~ + (when (and name (typep name '(or symbol cons))) + (multiple-value-bind (type where) + (if (or (symbolp name) (and (listp name) (eq (car name) 'setf))) + (values (type-specifier (info :function :type name)) + (info :function :where-from name)) + (values type-spec :defined)) + (when (consp type) + (format s "~@:_Its ~(~A~) argument types are:~@:_ ~S" + where (second type)) + (format s "~@:_Its result type is:~@:_ ~S" (third type)))) + (let ((inlinep (info :function :inlinep name))) + (when inlinep + (format s + "~@:_It is currently declared ~(~A~);~ ~:[no~;~] expansion is available." - inlinep (info :function :inline-expansion name))))) + inlinep (info :function :inline-expansion name)))))) ;;; Interpreted function describing; handles both closure and ;;; non-closure functions. Instead of printing the compiled-from info, @@ -143,12 +152,12 @@ s (type-specifier (sb-eval:interpreted-function-type x))))) (when closure-p - (format s "~@:_Its closure environment is:") + (format s "~@:_Its closure environment is:~%") (pprint-logical-block (s nil) (pprint-indent :current 2) - (let ((clos (sb-eval:interpreted-function-closure x))) - (dotimes (i (length clos)) - (format s "~@:_~S: ~S" i (svref clos i)))))) + (let ((closure (sb-eval:interpreted-function-closure x))) + (dotimes (i (length closure)) + (format s "~@:_~S: ~S" i (svref closure i)))))) (format s "~@:_Its definition is:~@:_ ~S" exp))) ;;; Print information from the debug-info about where CODE-OBJ was @@ -172,8 +181,8 @@ (ecase (sb-c::debug-source-from source) (:file (format s "~@:_~A~@:_ Created: " (namestring name)) - (sb-int:format-universal-time s (sb-c::debug-source-created - source))) + (format-universal-time s (sb-c::debug-source-created + source))) (:lisp (format s "~@:_~S" name)))))))))) ;;; Describe a compiled function. The closure case calls us to print @@ -270,9 +279,9 @@ (multiple-value-bind (symbol status) (find-symbol (symbol-name x) package) (declare (ignore symbol)) - (format s "~S is an ~(~A~) symbol in ~S." + (format s "~S is ~_an ~(~A~) symbol ~_in ~S." x status (symbol-package x))) - (format s "~S is an uninterned symbol." x))) + (format s "~S is ~_an uninterned symbol." x))) ;; TO DO: We could grovel over all packages looking for and ;; reporting other phenomena, e.g. IMPORT and SHADOW, or ;; availability in some package even after (SYMBOL-PACKAGE X) has @@ -295,12 +304,12 @@ (format s "~@" (eval x)))) ((boundp x) - (format s "~@:_It is a ~A; its value is ~S." wot (symbol-value x))) + (format s "~@:_It is a ~A; its ~_value is ~S." wot (symbol-value x))) ((not (eq kind :global)) (format s "~@:_It is a ~A; no current value." wot))) (when (eq (info :variable :where-from x) :declared) - (format s "~@:_Its declared type is ~S." + (format s "~@:_Its declared type ~_is ~S." (type-specifier (info :variable :type x)))) (%describe-doc x s 'variable kind)) @@ -318,9 +327,9 @@ ;; TO DO: Print out other stuff from the INFO database: ;; * Does it name a type or class? - ;; * Is it a structure accessor? (important since those are + ;; * Is it a structure accessor? (This is important since those are ;; magical in some ways, e.g. blasting the structure if you - ;; redefine them) + ;; redefine them.) ;; Print other documentation. (%describe-doc x s 'structure "Structure")