From e36adf21322abc31b1b61e20e93516f995b70c36 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 29 Jul 2009 14:51:23 +0000 Subject: [PATCH] 1.0.30.10: DESCRIBE reports on undefined but assumed/declared functions * If FTYPE has been declared, report it even if the function is not defined. * If calls to the function have been compiled, report it with an "assumed type" -- for now that is always FUNCTION, though. --- NEWS | 2 + src/code/describe.lisp | 160 ++++++++++++++++++++++++++---------------------- version.lisp-expr | 2 +- 3 files changed, 90 insertions(+), 74 deletions(-) diff --git a/NEWS b/NEWS index 9367e1c..05c25d6 100644 --- a/NEWS +++ b/NEWS @@ -15,6 +15,8 @@ changes relative to sbcl-1.0.30: * improvement: the compiler is able to track the effective type of generic function across method addition and removal even in the absence of an explicit DEFGENERIC. + * improvement: DESCRIBE now reports on symbols naming undefined + but assumed or declared function as well. * bug fix: moderately complex combinations of inline expansions could be miscompiled if the result was declared to be dynamic extent. * bug fix: in some cases no compiler note about failure to stack allocate diff --git a/src/code/describe.lisp b/src/code/describe.lisp index 468f4c0..6b73804 100644 --- a/src/code/describe.lisp +++ b/src/code/describe.lisp @@ -507,80 +507,94 @@ (defun describe-function (name function stream) (let ((name (if function (fun-name function) name))) - (when (or function (and (legal-fun-name-p name) (fboundp name))) - (multiple-value-bind (fun what lambda-list ftype from inline - methods) - (cond ((and (not function) (symbolp name) (special-operator-p name)) - (let ((fun (symbol-function name))) - (values fun "a special operator" (%fun-lambda-list fun)))) - ((and (not function) (symbolp name) (macro-function name)) - (let ((fun (macro-function name))) - (values fun "a macro" (%fun-lambda-list fun)))) - (t - (let ((fun (or function (fdefinition name)))) - (multiple-value-bind (ftype from) - (if function - (values (%fun-type function) "Derived") - (let ((ctype (info :function :type name))) - (values (when ctype (type-specifier ctype)) - (when ctype - (ecase (info :function :where-from name) - (:declared "Declared") - ;; This is hopefully clearer to users - ((:defined-method :defined) "Derived") - (:assumed)))))) - (if (typep fun 'generic-function) - (values fun - "a generic function" - (sb-mop:generic-function-lambda-list fun) - ftype - from - nil - (or (sb-mop:generic-function-methods fun) - :none)) - (values fun - (if (compiled-function-p fun) - "a compiled function" - "an interpreted function") - (%fun-lambda-list fun) - ftype - from - (unless function - (cons - (info :function :inlinep name) - (info :function :inline-expansion-designator name))))))))) - (pprint-logical-block (stream nil) - (unless function - (format stream "~%~A names ~A:" name what) - (pprint-indent :block 2 stream)) - (describe-lambda-list lambda-list stream) - (when (and ftype from) - (format stream "~@:_~A type: ~S" from ftype)) - (describe-documentation name 'function stream) - (when (car inline) - (format stream "~@:_Inline proclamation: ~A (~:[no ~;~]inline expansion available)" - (car inline) - (cdr inline))) - (when methods - (format stream "~@:_Method-combination: ~S" - (sb-pcl::method-combination-type-name - (sb-pcl:generic-function-method-combination fun))) - (cond ((eq :none methods) - (format stream "~@:_No methods.")) + (if (not (or function (and (legal-fun-name-p name) (fboundp name)))) + ;; Not defined, but possibly the type is declared, or we have + ;; compiled calls to it. + (when (legal-fun-name-p name) + (multiple-value-bind (from sure) (info :function :where-from name) + (when (or (eq :declared from) (and sure (eq :assumed from))) + (pprint-logical-block (stream nil) + (format stream "~%~A names an undefined function" name) + (pprint-indent :block 2 stream) + (format stream "~@:_~:(~A~) type: ~S" + from + (type-specifier (info :function :type name))))))) + ;; Defined. + (multiple-value-bind (fun what lambda-list ftype from inline + methods) + (cond ((and (not function) (symbolp name) (special-operator-p name)) + (let ((fun (symbol-function name))) + (values fun "a special operator" (%fun-lambda-list fun)))) + ((and (not function) (symbolp name) (macro-function name)) + (let ((fun (macro-function name))) + (values fun "a macro" (%fun-lambda-list fun)))) (t - (pprint-newline :mandatory stream) - (pprint-logical-block (stream nil) - (format stream "Methods:") - (dolist (method methods) - (pprint-indent :block 2 stream) - (format stream "~@:_(~A ~{~S ~}~:S)" - name - (method-qualifiers method) - (sb-pcl::unparse-specializers fun (sb-mop:method-specializers method))) - (pprint-indent :block 4 stream) - (describe-documentation method t stream nil)))))) - (describe-function-source fun stream) - (terpri stream))))) + (let ((fun (or function (fdefinition name)))) + (multiple-value-bind (ftype from) + (if function + (values (%fun-type function) "Derived") + (let ((ctype (info :function :type name))) + (values (when ctype (type-specifier ctype)) + (when ctype + ;; Ensure lazy pickup of information + ;; from methods. + (sb-c::maybe-update-info-for-gf name) + (ecase (info :function :where-from name) + (:declared "Declared") + ;; This is hopefully clearer to users + ((:defined-method :defined) "Derived")))))) + (if (typep fun 'generic-function) + (values fun + "a generic function" + (sb-mop:generic-function-lambda-list fun) + ftype + from + nil + (or (sb-mop:generic-function-methods fun) + :none)) + (values fun + (if (compiled-function-p fun) + "a compiled function" + "an interpreted function") + (%fun-lambda-list fun) + ftype + from + (unless function + (cons + (info :function :inlinep name) + (info :function :inline-expansion-designator name))))))))) + (pprint-logical-block (stream nil) + (unless function + (format stream "~%~A names ~A:" name what) + (pprint-indent :block 2 stream)) + (describe-lambda-list lambda-list stream) + (when (and ftype from) + (format stream "~@:_~A type: ~S" from ftype)) + (describe-documentation name 'function stream) + (when (car inline) + (format stream "~@:_Inline proclamation: ~A (~:[no ~;~]inline expansion available)" + (car inline) + (cdr inline))) + (when methods + (format stream "~@:_Method-combination: ~S" + (sb-pcl::method-combination-type-name + (sb-pcl:generic-function-method-combination fun))) + (cond ((eq :none methods) + (format stream "~@:_No methods.")) + (t + (pprint-newline :mandatory stream) + (pprint-logical-block (stream nil) + (format stream "Methods:") + (dolist (method methods) + (pprint-indent :block 2 stream) + (format stream "~@:_(~A ~{~S ~}~:S)" + name + (method-qualifiers method) + (sb-pcl::unparse-specializers fun (sb-mop:method-specializers method))) + (pprint-indent :block 4 stream) + (describe-documentation method t stream nil)))))) + (describe-function-source fun stream) + (terpri stream))))) (unless function (awhen (and (legal-fun-name-p name) (compiler-macro-function name)) (pprint-logical-block (stream nil) diff --git a/version.lisp-expr b/version.lisp-expr index 1ee7365..c65456a 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.30.9" +"1.0.30.10" -- 1.7.10.4