Commit 925010e8 authored by Eric Timmons's avatar Eric Timmons
Browse files

Make groveler a bit faster

parent d9c9ccec
...@@ -31,34 +31,66 @@ ...@@ -31,34 +31,66 @@
(defvar *cache* (make-hash-table :test 'equalp)) (defvar *cache* (make-hash-table :test 'equalp))
(defun chase-package-inferred-deps (system-name parent-system-name) ;; (defun chase-package-inferred-deps (system-name parent-system-name)
(if (gethash system-name *cache*) ;; (if (gethash system-name *cache*)
nil ;; nil
(setf (gethash system-name *cache*) ;; (setf (gethash system-name *cache*)
(cond ;; (cond
((listp system-name) ;; ((listp system-name)
(list system-name)) ;; (list system-name))
((string= parent-system-name ;; ((string= parent-system-name
(asdf:primary-system-name system-name)) ;; (asdf:primary-system-name system-name))
(mapcan (lambda (d) ;; (mapcan (lambda (d)
(chase-package-inferred-deps d parent-system-name)) ;; (chase-package-inferred-deps d parent-system-name))
(asdf:system-depends-on (asdf:find-system system-name)))) ;; (asdf:system-depends-on (asdf:find-system system-name))))
(t ;; (t
(list system-name)))))) ;; (list system-name))))))
(defgeneric asdf-dependency-system-name (dep))
(defmethod asdf-dependency-system-name ((dep string))
(defmethod asdf-dependency-system-name ((dep list))
(case (first dep)
(second dep))
(defun clean-up-deps-list (dependencies)
(remove-if (lambda (x)
(gethash x *cache*))
:test #'equalp))
(defun chase-package-inferred-deps (dependencies system)
(let ((dep-with-same-primary-system (find-if (lambda (x)
(equal (asdf:primary-system-name system)
(asdf-dependency-system-name x))))
(if dep-with-same-primary-system
;; There is a dependency with the same primary system name. Replace it
;; with its dependencies.
(let ((new-dependencies
(append (asdf:system-depends-on
(asdf:find-system (asdf-dependency-system-name dep-with-same-primary-system)))
(remove dep-with-same-primary-system dependencies))))
(setf (gethash dep-with-same-primary-system *cache*) t)
(chase-package-inferred-deps (clean-up-deps-list new-dependencies) system))
(defun system-direct-deps (system) (defun system-direct-deps (system)
(let* ((defsystem-deps (asdf:system-defsystem-depends-on system)) (let* ((defsystem-deps (asdf:system-defsystem-depends-on system))
(source-file (asdf:system-source-file system)) (source-file (asdf:system-source-file system))
(*cache* (make-hash-table :test 'equalp)) (*cache* (make-hash-table :test 'equalp))
(depends-on (asdf:system-depends-on system) (direct-depends-on (asdf:system-depends-on system))
;; (if (typep system 'asdf:package-inferred-system) (depends-on (if (typep system 'asdf:package-inferred-system)
;; (remove-duplicates (chase-package-inferred-deps direct-depends-on system)
;; (chase-package-inferred-deps direct-depends-on)))
;; (asdf:component-name system)
;; (asdf:primary-system-name (asdf:component-name system)))
;; :test #'equalp)
;; (asdf:system-depends-on system))
`(,(asdf:component-name system) `(,(asdf:component-name system)
:depends-on ,depends-on :depends-on ,depends-on
:version ,(asdf:component-version system) :version ,(asdf:component-version system)
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment