[slime-devel] XREF for SBCL

[Nikodemus Siivola]

The attached patch + new file hooks the PXREF to SBCL as well, sharing 
code with the Clisp backend.

To make usage a bit less tedious I hooked PXREF:XREF-FILE into 
swank-compile-file.

Clisp hasn't been tested after these changes, and neither has SBCL been 
subjected to much pounding, but "seems to work".

To make the pxref more useful it might make sense to save the collected db 
on exits and load on startup... Also, an xref-op for asdf would not come 
amiss. (Just noting these out loud in case someone has nothing to do over 
the weekend.)

Cheers,

  -- Nikodemus              Schemer: "Buddha is small, clean, and serious."
                   Lispnik: "Buddha is big, has hairy armpits, and laughs."
-------------- next part --------------
(in-package :swank-backend)

(setq pxref::*handle-package-forms* '(cl:in-package))

(defmacro defxref (name function)
  `(defimplementation ,name (name)
     (xref-results (,function name))))
  
(defxref who-calls      pxref:list-callers)
(defxref who-references pxref:list-readers)
(defxref who-binds      pxref:list-setters)
(defxref who-sets       pxref:list-setters)
(defxref list-callers   pxref:list-callers)
(defxref list-callees   pxref:list-callees)

(defun xref-results (symbols)
  (reduce #'append (mapcar #'find-definitions symbols)))
-------------- next part --------------
? sbcl-xref.patch
? swank-pxref.lisp
? xref-backend.lisp
? doc/contributors.texi
? doc/slime.aux
? doc/slime.cp
? doc/slime.dvi
? doc/slime.fn
? doc/slime.info
? doc/slime.ky
? doc/slime.log
? doc/slime.pg
? doc/slime.ps
? doc/slime.tmp
? doc/slime.toc
? doc/slime.tp
? doc/slime.vr
Index: swank-clisp.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-clisp.lisp,v
retrieving revision 1.33
diff -u -r1.33 swank-clisp.lisp
--- swank-clisp.lisp	25 Jun 2004 08:05:29 -0000	1.33
+++ swank-clisp.lisp	21 Aug 2004 00:39:51 -0000
@@ -350,7 +350,8 @@
     (with-compilation-unit ()
       (let ((fasl-file (compile-file filename)))
 	(when (and load-p fasl-file)
-	  (load fasl-file))
+	  (load fasl-file)
+	  (pxref:xref-file filename))
 	nil))))
 
 (defimplementation swank-compile-string (string &key buffer position)
@@ -359,27 +360,6 @@
 	  (*buffer-offset* position))
       (funcall (compile nil (read-from-string
                              (format nil "(~S () ~A)" 'lambda string)))))))
-
-;;; Portable XREF from the CMU AI repository.
-
-(setq pxref::*handle-package-forms* '(cl:in-package))
-
-(defmacro defxref (name function)
-  `(defimplementation ,name (name)
-    (xref-results (,function name))))
-
-(defxref who-calls      pxref:list-callers)
-(defxref who-references pxref:list-readers)
-(defxref who-binds      pxref:list-setters)
-(defxref who-sets       pxref:list-setters)
-(defxref list-callers   pxref:list-callers)
-(defxref list-callees   pxref:list-callees)
-
-(defun xref-results (symbols)
-  (let ((xrefs '()))
-    (dolist (symbol symbols)
-      (push (list symbol (fspec-location symbol)) xrefs))
-    xrefs))
 
 (when (find-package :swank-loader)
   (setf (symbol-function (intern "USER-INIT-FILE" :swank-loader))
Index: swank-loader.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-loader.lisp,v
retrieving revision 1.31
diff -u -r1.31 swank-loader.lisp
--- swank-loader.lisp	12 Jul 2004 10:36:31 -0000	1.31
+++ swank-loader.lisp	21 Aug 2004 00:39:52 -0000
@@ -32,11 +32,11 @@
           (append 
            '("nregex")
            #+cmu '("swank-source-path-parser" "swank-cmucl")
-           #+sbcl '("swank-sbcl" "swank-source-path-parser" "swank-gray")
+           #+sbcl '("xref" "swank-sbcl" "swank-source-path-parser" "swank-gray" "swank-pxref")
            #+openmcl '("swank-openmcl" "swank-gray")
            #+lispworks '("swank-lispworks" "swank-gray")
            #+allegro '("swank-allegro" "swank-gray")
-           #+clisp '("xref" "metering" "swank-clisp" "swank-gray")
+           #+clisp '("xref" "metering" "swank-clisp" "swank-gray" "swank-pxref")
            #+armedbear '("swank-abcl" "swank-gray")
            )))
 
Index: swank-sbcl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-sbcl.lisp,v
retrieving revision 1.97
diff -u -r1.97 swank-sbcl.lisp
--- swank-sbcl.lisp	28 Jul 2004 21:07:18 -0000	1.97
+++ swank-sbcl.lisp	21 Aug 2004 00:39:52 -0000
@@ -298,7 +298,9 @@
       (let ((output-file (with-compilation-hooks ()
                            (compile-file filename))))
         (when (and load-p output-file)
-          (load output-file)))
+          (prog1
+              (load output-file)
+            (pxref:xref-file filename))))
     (sb-c:fatal-compiler-error () nil)))
 
 (defimplementation swank-compile-string (string &key buffer position)
@@ -307,7 +309,7 @@
              (with-compilation-hooks ()
                (let ((*buffer-name* buffer)
                      (*buffer-offset* position)
-                     (*buffer-substring* string))
+                     (*buffer-substring* string))                 
                  (funcall cont (compile nil form))))))
       (cond (*trap-load-time-warnings*
              (compileit #'funcall))