0.9.12.30:
[sbcl.git] / contrib / sb-introspect / sb-introspect.lisp
index aa323a6..a5ff21f 100644 (file)
@@ -140,7 +140,10 @@ If an unsupported TYPE is requested, the function will return NIL.
   (flet ((listify (x)
            (if (listp x)
                x
-               (list x))))
+               (list x)))
+         (get-class (name)
+           (and (symbolp name)
+                (find-class name nil))))
     (listify
      (case type
        ((:variable)
@@ -192,7 +195,7 @@ If an unsupported TYPE is requested, the function will return NIL.
                                                       (symbol-function expander)
                                                       expander)))))
        ((:structure)
-        (let ((class (find-class name nil)))
+        (let ((class (get-class name)))
           (if class
               (when (typep class 'sb-pcl::structure-class)
                 (find-definition-source class))
@@ -200,7 +203,7 @@ If an unsupported TYPE is requested, the function will return NIL.
                 (translate-source-location
                  (sb-int:info :source-location :typed-structure name))))))
        ((:condition :class)
-        (let ((class (find-class name nil)))
+        (let ((class (get-class name)))
           (when (and class
                      (not (typep class 'sb-pcl::structure-class)))
             (when (eq (not (typep class 'sb-pcl::condition-class))
@@ -281,8 +284,8 @@ If an unsupported TYPE is requested, the function will return NIL.
               (sb-kernel::layout-source-location layout)))))))
     (method-combination
      (car
-      (find-definition-sources-by-name (sb-pcl::method-combination-type object)
-                                       :method-combination)))
+      (find-definition-sources-by-name
+       (sb-pcl::method-combination-type-name object) :method-combination)))
     (package
      (translate-source-location (sb-impl::package-source-location object)))
     (class
@@ -377,12 +380,13 @@ If an unsupported TYPE is requested, the function will return NIL.
 
 ;;; FIXME: maybe this should be renamed as FUNCTION-LAMBDA-LIST?
 (defun function-arglist (function)
-  "Describe the lambda list for the function designator FUNCTION.
+  "Describe the lambda list for the extended function designator FUNCTION.
 Works for special-operators, macros, simple functions and generic
 functions.  Signals error if not found"
   (cond ((valid-function-name-p function)
-         (function-arglist
-          (or (macro-function function) (fdefinition function))))
+         (function-arglist (or (and (symbolp function)
+                                    (macro-function function))
+                               (fdefinition function))))
         ((typep function 'generic-function)
          (sb-pcl::generic-function-pretty-arglist function))
         (t (sb-impl::%simple-fun-arglist