From: Stas Boukarev <stassats@gmail.com>
Date: Tue, 7 May 2013 18:47:31 +0000 (+0400)
Subject: sb-introspect:find-definition-sources-by-name: more defoptimizer types.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=01f29363993816f6d5fb6139f356df84cfaa1fc6;p=sbcl.git

sb-introspect:find-definition-sources-by-name: more defoptimizer types.

Look for sb-c:ir2-convert and sb-c::stack-allocate-result defoptimizer types.
---

diff --git a/NEWS b/NEWS
index 48e6e1f..dd3a55d 100644
--- a/NEWS
+++ b/NEWS
@@ -7,7 +7,8 @@ changes relative to sbcl-1.1.7:
   * enhancement: "fixed objects" can now be stack-allocated on PPC.
   * enhancement: WITH-PINNED-OBJECTS no longer conses on PPC/GENCGC.
   * enhancement: (sb-introspect:find-definition-sources-by-name x :vop) now
-    also returns VOPs which do not translate any functions.
+    also returns VOPs which do not translate any functions, and finds
+    defoptimizer types ir2convert and stack-allocate-result.
   * enhancement: better type derivation for APPEND, NCONC, LIST.
     (lp#538957)
   * bug fix: type derivation for LOG{AND,IOR,XOR} scales linearly instead
diff --git a/contrib/sb-introspect/introspect.lisp b/contrib/sb-introspect/introspect.lisp
index 3a683e7..c59b99b 100644
--- a/contrib/sb-introspect/introspect.lisp
+++ b/contrib/sb-introspect/introspect.lisp
@@ -246,9 +246,9 @@ If an unsupported TYPE is requested, the function will return NIL.
         (let ((expander (or (sb-int:info :setf :inverse name)
                             (sb-int:info :setf :expander name))))
           (when expander
-            (sb-introspect:find-definition-source (if (symbolp expander)
-                                                      (symbol-function expander)
-                                                      expander)))))
+            (find-definition-source (if (symbolp expander)
+                                        (symbol-function expander)
+                                        expander)))))
        ((:structure)
         (let ((class (get-class name)))
           (if class
@@ -296,20 +296,22 @@ If an unsupported TYPE is requested, the function will return NIL.
                                  (list note)))
                     collect source)))))
        ((:optimizer)
-        (when (symbolp name)
-          (let ((fun-info (sb-int:info :function :info name)))
-            (when fun-info
-              (let ((otypes '((sb-c::fun-info-derive-type . sb-c:derive-type)
-                              (sb-c::fun-info-ltn-annotate . sb-c:ltn-annotate)
-                              (sb-c::fun-info-ltn-annotate . sb-c:ltn-annotate)
-                              (sb-c::fun-info-optimizer . sb-c:optimizer))))
-                (loop for (reader . name) in otypes
-                      for fn = (funcall reader fun-info)
-                      when fn collect
-                      (let ((source (find-definition-source fn)))
-                        (setf (definition-source-description source)
-                              (list name))
-                        source)))))))
+        (let ((fun-info (and (symbolp name)
+                             (sb-int:info :function :info name))))
+          (when fun-info
+            (let ((otypes '((sb-c:fun-info-derive-type . sb-c:derive-type)
+                            (sb-c:fun-info-ltn-annotate . sb-c:ltn-annotate)
+                            (sb-c:fun-info-optimizer . sb-c:optimizer)
+                            (sb-c:fun-info-ir2-convert . sb-c:ir2-convert)
+                            (sb-c::fun-info-stack-allocate-result
+                             . sb-c::stack-allocate-result))))
+              (loop for (reader . name) in otypes
+                    for fn = (funcall reader fun-info)
+                    when fn collect
+                    (let ((source (find-definition-source fn)))
+                      (setf (definition-source-description source)
+                            (list name))
+                      source))))))
        ((:vop)
         (when (symbolp name)
           (find-vop-source name)))
@@ -317,7 +319,7 @@ If an unsupported TYPE is requested, the function will return NIL.
         (when (symbolp name)
           (let ((transform-fun (sb-int:info :function :source-transform name)))
             (when transform-fun
-              (sb-introspect:find-definition-source transform-fun)))))
+              (find-definition-source transform-fun)))))
        (t
         nil)))))