[slime-cvs] CVS slime

heller heller at common-lisp.net
Thu Oct 19 12:30:51 UTC 2006


Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv8708

Modified Files:
	swank-sbcl.lisp 
Log Message:
(list-callers, list-callers): Use SANITIZE-XREFS.


--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2006/10/17 10:48:35	1.167
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2006/10/19 12:30:51	1.168
@@ -572,15 +572,29 @@
 
 (defimplementation list-callers (symbol)
   (let ((fn (fdefinition symbol)))
-    (mapcar #'function-dspec (sb-introspect:find-function-callers fn))))
+    (sanitize-xrefs
+     (mapcar #'function-dspec (sb-introspect:find-function-callers fn)))))
 
 (defimplementation list-callees (symbol)
   (let ((fn (fdefinition symbol)))
-    (mapcar #'function-dspec (sb-introspect:find-function-callees fn))))
+    (sanitize-xrefs
+     (mapcar #'function-dspec (sb-introspect:find-function-callees fn)))))
 
-#-#.(swank-backend::sbcl-with-new-stepper-p)
-(defimplementation ignored-xref-function-names ()
-  '(nil sb-c::step-form sb-c::step-values))
+(defun sanitize-xrefs (x)
+  (remove-duplicates
+   (remove-if (lambda (f)
+                (member f (ignored-xref-function-names)))
+              x
+              :key #'car)
+   :test (lambda (a b)
+           (and (eq (first a) (first b))
+                (equal (second a) (second b))))))
+
+(defun ignored-xref-function-names ()
+  #-#.(swank-backend::sbcl-with-new-stepper-p)
+  '(nil sb-c::step-form sb-c::step-values)
+  #+#.(swank-backend::sbcl-with-new-stepper-p)
+  '(nil))
 
 (defun function-dspec (fn)
   "Describe where the function FN was defined.




More information about the slime-cvs mailing list