Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
clpm
clpm
Commits
925010e8
Commit
925010e8
authored
Aug 13, 2019
by
Eric Timmons
Browse files
Make groveler a bit faster
parent
d9c9ccec
Changes
1
Hide whitespace changes
Inline
Side-by-side
src/clpm-deps/main.lisp
View file @
925010e8
...
...
@@ -31,34 +31,66 @@
(
defvar
*cache*
(
make-hash-table
:test
'equalp
))
(
defun
chase-package-inferred-deps
(
system-name
parent-system-name
)
(
if
(
gethash
system-name
*cache*
)
nil
(
setf
(
gethash
system-name
*cache*
)
(
cond
((
listp
system-name
)
(
list
system-name
))
((
string=
parent-system-name
(
asdf:primary-system-name
system-name
))
(
mapcan
(
lambda
(
d
)
(
chase-package-inferred-deps
d
parent-system-name
))
(
asdf:system-depends-on
(
asdf:find-system
system-name
))))
(
t
(
list
system-name
))))))
;; (defun chase-package-inferred-deps (system-name parent-system-name)
;; (if (gethash system-name *cache*)
;; nil
;; (setf (gethash system-name *cache*)
;; (cond
;; ((listp system-name)
;; (list system-name))
;; ((string= parent-system-name
;; (asdf:primary-system-name system-name))
;; (mapcan (lambda (d)
;; (chase-package-inferred-deps d parent-system-name))
;; (asdf:system-depends-on (asdf:find-system system-name))))
;; (t
;; (list system-name))))))
(
defgeneric
asdf-dependency-system-name
(
dep
))
(
defmethod
asdf-dependency-system-name
((
dep
string
))
dep
)
(
defmethod
asdf-dependency-system-name
((
dep
list
))
(
case
(
first
dep
)
(
:version
(
second
dep
))
(
t
nil
)))
(
defun
clean-up-deps-list
(
dependencies
)
(
remove-duplicates
(
remove-if
(
lambda
(
x
)
(
gethash
x
*cache*
))
dependencies
)
: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:primary-system-name
(
asdf-dependency-system-name
x
))))
dependencies
)))
(
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
))
dependencies
)))
(
defun
system-direct-deps
(
system
)
(
let*
((
defsystem-deps
(
asdf:system-defsystem-depends-on
system
))
(
source-file
(
asdf:system-source-file
system
))
(
*cache*
(
make-hash-table
:test
'equalp
))
(
depends-on
(
asdf:system-depends-on
system
)
;; (if (typep system 'asdf:package-inferred-system)
;; (remove-duplicates
;; (chase-package-inferred-deps
;; (asdf:component-name system)
;; (asdf:primary-system-name (asdf:component-name system)))
;; :test #'equalp)
;; (asdf:system-depends-on system))
))
(
direct-depends-on
(
asdf:system-depends-on
system
))
(
depends-on
(
if
(
typep
system
'asdf:package-inferred-system
)
(
chase-package-inferred-deps
direct-depends-on
system
)
direct-depends-on
)))
`
(
,
(
asdf:component-name
system
)
:depends-on
,
depends-on
:version
,
(
asdf:component-version
system
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment