[slime-cvs] CVS slime/contrib

[CVS User sboukarev]

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

Modified Files:
	ChangeLog swank-asdf.lisp 
Log Message:
* contrib/swank-asdf.lisp (asdf-determine-system): Rewritten to be much
faster and to cons less (and look ugly).


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/16 15:47:54	1.275
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/17 10:13:40	1.276
@@ -1,3 +1,8 @@
+2009-11-17  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-asdf.lisp (asdf-determine-system): Rewritten to be much
+	faster and to cons less (and look ugly).
+
 2009-11-16  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-asdf.lisp (asdf-determine-system): New function for
--- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/11/16 15:47:55	1.11
+++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/11/17 10:13:40	1.12
@@ -9,6 +9,7 @@
 
 (in-package :swank)
 
+#-asdf
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (require :asdf))
 
@@ -65,12 +66,12 @@
           :test #'string=))
 
 (defun asdf-module-files (module)
-  (mapcan #'(lambda (component)
-              (typecase component
-                (asdf:cl-source-file
-                 (list (asdf:component-pathname component)))
-                (asdf:module
-                 (asdf-module-files component))))
+  (mapcan (lambda (component)
+            (typecase component
+              (asdf:cl-source-file
+               (list (asdf:component-pathname component)))
+              (asdf:module
+               (asdf-module-files component))))
           (asdf:module-components module)))
 
 (defslimefun asdf-system-files (name)
@@ -92,10 +93,25 @@
    (cl:truename
     (asdf:system-definition-pathname (asdf:find-system name)))))
 
+;;; This looks a little bit ugly, but it needs to be fast because
+;;; there can be many systems with many files
+(defun system-contains-file-p (module pathname pathname-name)
+  (dolist (component (asdf:module-components module))
+    (typecase component
+      (asdf:cl-source-file
+       (when (and (equal pathname-name
+                         (pathname-name
+                          (asdf:component-relative-pathname component)))
+                  (equal pathname (asdf:component-pathname component)))
+         (return t)))
+      (asdf:module
+       (system-contains-file-p component pathname pathname-name)))))
+
 (defslimefun asdf-determine-system (file)
-  (find-if (lambda (system)
-             (member file (asdf-system-files system)
-                     :test #'equal))
-           (list-all-systems-known-to-asdf)))
+  (loop with pathname = (pathname file)
+        with pathname-name = (pathname-name pathname)
+        for (nil . system) being the hash-value of asdf::*defined-systems*
+        when (system-contains-file-p system pathname pathname-name)
+        return (asdf:component-name system)))
 
 (provide :swank-asdf)