X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-introspect%2Fintrospect.lisp;h=1b97c67742eb50316cd0055e3c4443685a4d0d66;hb=1f03c7f326823245708a84af86b31ac72bdb1742;hp=ff854a6e69cf977c0741a9b33a6194910cd88665;hpb=8a935232db803d74b2d79b5fb0fc3b3cd5d7beb3;p=sbcl.git

diff --git a/contrib/sb-introspect/introspect.lisp b/contrib/sb-introspect/introspect.lisp
index ff854a6..1b97c67 100644
--- a/contrib/sb-introspect/introspect.lisp
+++ b/contrib/sb-introspect/introspect.lisp
@@ -358,7 +358,7 @@ If an unsupported TYPE is requested, the function will return NIL.
     ((or condition standard-object structure-object)
      (find-definition-source (class-of object)))
     (t
-     (error "Don't know how to retrieve 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)
@@ -451,7 +451,19 @@ function designator."
   "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))
+  (check-type typespec-operator symbol)
+  (case (sb-int:info :type :kind typespec-operator)
+    (:defined
+     (sb-int:info :type :lambda-list typespec-operator))
+    (:primitive
+     (let ((translator-fun (sb-int:info :type :translator typespec-operator)))
+       (if translator-fun
+           (values (sb-kernel:%fun-lambda-list translator-fun) t)
+           ;; Some builtin types (e.g. STRING) do not have a
+           ;; translator, but they were actually defined via DEFTYPE
+           ;; in src/code/deftypes-for-target.lisp.
+           (sb-int:info :type :lambda-list typespec-operator))))
+    (t (values nil nil))))
 
 (defun struct-accessor-structure-class (function)
   (let ((self (sb-vm::%simple-fun-self function)))
@@ -639,6 +651,8 @@ designated class.
 Experimental.
 "
   (let ((class (canonicalize-class-designator class-designator)))
+    (unless class
+      (return-from who-specializes-directly nil))
     (let ((result (collect-specializing-methods
                    #'(lambda (specl)
                        ;; Does SPECL specialize on CLASS directly?
@@ -670,6 +684,8 @@ designated class or a subclass of it.
 Experimental.
 "
   (let ((class (canonicalize-class-designator class-designator)))
+    (unless class
+      (return-from who-specializes-generally nil))
     (let ((result (collect-specializing-methods
                    #'(lambda (specl)
                        ;; Does SPECL specialize on CLASS or a subclass
@@ -689,9 +705,10 @@ Experimental.
                 result))))
 
 (defun canonicalize-class-designator (class-designator)
-  (etypecase class-designator
-    (symbol (find-class class-designator))
-    (class  class-designator)))
+  (typecase class-designator
+    (symbol (find-class class-designator nil))
+    (class  class-designator)
+    (t nil)))
 
 (defun method-generic-function-name (method)
   (sb-mop:generic-function-name (sb-mop:method-generic-function method)))