[slime-cvs] CVS slime

[CVS User heller]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv19836

Modified Files:
	ChangeLog swank-cmucl.lisp 
Log Message:
Find definition for (%primitive NAME ...)

* swank-cmucl.lisp (template-definitions, primitive-definitions):
New functions.
(find-definitions): Use them.

--- /project/slime/cvsroot/slime/ChangeLog	2010/06/22 10:02:49	1.2112
+++ /project/slime/cvsroot/slime/ChangeLog	2010/07/06 12:09:19	1.2113
@@ -1,3 +1,11 @@
+2010-07-06  Helmut Eller  <heller at common-lisp.net>
+
+	Find definition for (%primitive NAME ...)
+
+	* swank-cmucl.lisp (template-definitions, primitive-definitions):
+	New functions.
+	(find-definitions): Use them.
+
 2010-06-22  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-loader.lisp (*architecture-features*): ECL uses :x86_64.
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2010/05/27 14:47:56	1.224
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2010/07/06 12:09:20	1.225
@@ -898,7 +898,9 @@
           (compiler-macro-definitions name)
           (source-transform-definitions name)
           (function-info-definitions name)
-          (ir1-translator-definitions name)))
+          (ir1-translator-definitions name)
+          (template-definitions name)
+          (primitive-definitions name)))
 
 ;;;;; Functions, macros, generic functions, methods
 ;;;
@@ -1248,7 +1250,8 @@
                 (maybe-make-definition (c::function-info-ir2-convert info)
                                        'c::ir2-convert name)
                 (loop for template in (c::function-info-templates info)
-                      collect (list `(c::vop ,(c::template-name template))
+                      collect (list `(,(type-of template)
+                                       ,(c::template-name template))
                                     (function-location 
                                      (c::vop-info-generator-function 
                                       template))))))))
@@ -1257,6 +1260,22 @@
   (maybe-make-definition (ext:info :function :ir1-convert name)
                          'c:def-ir1-translator name))
 
+(defun template-definitions (name)
+  (let* ((templates (c::backend-template-names c::*backend*))
+         (template (gethash name templates)))
+    (etypecase template
+      (null)
+      (c::vop-info
+       (maybe-make-definition (c::vop-info-generator-function template)
+                              (type-of template) name)))))
+
+;; for cases like: (%primitive NAME ...)
+(defun primitive-definitions (name)
+  (let ((csym (find-symbol (string name) 'c)))
+    (and csym
+         (not (eq csym name))
+         (template-definitions csym))))
+
 
 ;;;; Documentation.