X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-introspect%2Fsb-introspect.lisp;h=d962f6cf7fb68a4b5221240c9d046f9b6e0b2587;hb=d56803388a0a0a35e1889596f928b367c650c15b;hp=9b21d615606be840752f770efc4e8c8f34055bae;hpb=45043cae0617dd0f8071e97cd9ee2d6359a9f9e9;p=sbcl.git

diff --git a/contrib/sb-introspect/sb-introspect.lisp b/contrib/sb-introspect/sb-introspect.lisp
index 9b21d61..d962f6c 100644
--- a/contrib/sb-introspect/sb-introspect.lisp
+++ b/contrib/sb-introspect/sb-introspect.lisp
@@ -25,6 +25,8 @@
 (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"
@@ -192,7 +194,8 @@ If an unsupported TYPE is requested, the function will return NIL.
           (if loc
               (translate-source-location loc)
               (let ((expander-fun (sb-int:info :type :expander name)))
-                (find-definition-source expander-fun)))))
+                (when expander-fun
+                  (find-definition-source expander-fun))))))
        ((:method)
         (when (fboundp name)
           (let ((fun (real-fdefinition name)))
@@ -412,22 +415,36 @@ If an unsupported TYPE is requested, the function will return NIL.
     ;; 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)))