(defpackage :sb-introspect
(:use "CL")
(:export "FUNCTION-ARGLIST"
+ "FUNCTION-LAMBDA-LIST"
+ "DEFTYPE-LAMBDA-LIST"
"VALID-FUNCTION-NAME-P"
"FIND-DEFINITION-SOURCE"
"FIND-DEFINITION-SOURCES-BY-NAME"
(not (eq type :generic-function)))
(find-definition-source fun)))))
((:type)
- (let ((expander-fun (sb-int:info :type :expander name)))
- (when expander-fun
- (find-definition-source expander-fun))))
+ ;; Source locations for types are saved separately when the expander
+ ;; is a closure without a good source-location.
+ (let ((loc (sb-int:info :type :source-location name)))
+ (if loc
+ (translate-source-location loc)
+ (let ((expander-fun (sb-int:info :type :expander name)))
+ (when expander-fun
+ (find-definition-source expander-fun))))))
((:method)
(when (fboundp name)
(let ((fun (real-fdefinition name)))
(find-definition-source class)))))
((:method-combination)
(let ((combination-fun
- (ignore-errors (find-method #'sb-mop:find-method-combination
- nil
- (list (find-class 'generic-function)
- (list 'eql name)
- t)))))
+ (find-method #'sb-mop:find-method-combination
+ nil
+ (list (find-class 'generic-function)
+ (list 'eql name)
+ t)
+ nil)))
(when combination-fun
(find-definition-source combination-fun))))
((:package)
(struct-predicate-structure-class object)))
(t
(find-function-definition-source object))))
+ ((or condition standard-object structure-object)
+ (find-definition-source (class-of object)))
(t
- (error "Don't know how to retrive source location for a ~S~%"
+ (error "Don't know how to retrieve source location for a ~S~%"
(type-of object)))))
(defun find-function-definition-source (function)
(tlf (if debug-fun (sb-c::compiled-debug-fun-tlf-number debug-fun))))
(make-definition-source
:pathname
- (if (eql (sb-c::debug-source-from debug-source) :file)
- (parse-namestring (sb-c::debug-source-name debug-source)))
+ ;; KLUDGE: at the moment, we don't record the correct toplevel
+ ;; form number for forms processed by EVAL (including EVAL-WHEN
+ ;; :COMPILE-TOPLEVEL). Until that's fixed, don't return a
+ ;; DEFINITION-SOURCE with a pathname. (When that's fixed, take
+ ;; out the (not (debug-source-form ...)) test.
+ (if (and (sb-c::debug-source-namestring debug-source)
+ (not (sb-c::debug-source-form debug-source)))
+ (parse-namestring (sb-c::debug-source-namestring debug-source)))
:character-offset
(if tlf
(elt (sb-c::debug-source-start-positions debug-source) tlf))
;; FIXME there may be other structure predicate functions
(member self (list *struct-predicate*))))
-;;; FIXME: maybe this should be renamed as FUNCTION-LAMBDA-LIST?
(defun function-arglist (function)
+ "Deprecated alias for FUNCTION-LAMBDA-LIST."
+ (function-lambda-list function))
+
+(define-compiler-macro function-arglist (function)
+ (sb-int:deprecation-warning 'function-arglist 'function-lambda-list)
+ `(function-lambda-list ,function))
+
+(defun function-lambda-list (function)
"Describe the lambda list for the extended function designator FUNCTION.
-Works for special-operators, macros, simple functions,
-interpreted functions, and generic functions. Signals error if
-not found"
+Works for special-operators, macros, simple functions, interpreted functions,
+and generic functions. Signals an error if FUNCTION is not a valid extended
+function designator."
(cond ((valid-function-name-p function)
- (function-arglist (or (and (symbolp function)
- (macro-function function))
- (fdefinition function))))
+ (function-lambda-list (or (and (symbolp function)
+ (macro-function function))
+ (fdefinition function))))
((typep function 'generic-function)
(sb-pcl::generic-function-pretty-arglist function))
#+sb-eval
((typep function 'sb-eval:interpreted-function)
(sb-eval:interpreted-function-lambda-list function))
- (t (sb-kernel:%simple-fun-arglist (sb-kernel:%fun-fun function)))))
+ (t
+ (sb-kernel:%simple-fun-arglist (sb-kernel:%fun-fun function)))))
+
+(defun deftype-lambda-list (typespec-operator)
+ "Returns the lambda list of TYPESPEC-OPERATOR as first return
+value, and a flag whether the arglist could be found as second
+value."
+ (sb-int:info :type :lambda-list typespec-operator))
(defun struct-accessor-structure-class (function)
(let ((self (sb-vm::%simple-fun-self function)))