diff --git a/TODO b/TODO index 84cfd0d7bc1a4a601c45697b7f636f14801bbc81..3fcb657f91e6173a6a2c6c60f1d339bfedcad505 100644 --- a/TODO +++ b/TODO @@ -395,3 +395,20 @@ It looks like SWANK can be fixed soon, though, so we'll see. *** when everyone has migrated, remove the old mode and the short-circuit. ** However, we cannot deprecate component-depends-on yet — not until we have some transition in place to a better interface. + + +* Faster source-registry: + In addition and/or as a substitute to the .cl-source-registry.cache, + that is meant to be semi-automatically managed, there could be + a cl-source-registry.conf meant for manual management: + when recursing into a source-registry :tree, if such file is present + (or if not, if a hidden .cl-source-registry.conf is present instead?), + its contents is read as a (:source-registry ...) specification, and + replaces the actual or notional (:tree ...) for the current directory; + it may then include :file entries as well as :directory and :tree entries, + whereby the programmer can explicitly give a definitive list of + systems exported by his software, while excluding any test system + that he doesn't want to export. This means that developers have + both a way of speeding up the build of their software and of + avoiding pollution by test systems that should remain private, + and that they can otherwise explicitly enable when they need them. diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index 17f9b7ac4fda840b9ee6475fb19e27fe21c2f097..57be62543c8445808fe41795ea94811094394c11 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -3439,7 +3439,47 @@ specifications from the next configuration The implementation is allowed to either eagerly compute the information from the configurations and file system, or to lazily re-compute it every time, or to cache any part of it as it goes. -To explicitly flush any information cached by the system, use the API below. +In practice, the recommended @code{source-registry} eagerly collects and caches results +and you need to explicitly flush the cache for change to be taken into account, +whereas the old-style @code{*central-registry*} mechanism queries the filesystem every time. + +To explicitly flush any information cached by the system +after a change was made in the filesystem, @xref{Configuration API}, +and e.g. call @code{asdf:clear-source-registry}. + +Starting with ASDF 3.1.4, you can also explicitly build a persistent cache +of the @file{.asd} files found under a tree: +when recursing into a directory declared by @code{:tree} and its transitive subdirectories, +if a file @file{.cl-source-registry.cache} exists containing a form +that is a list starting with @code{:source-registry-cache} followed by a list of strings, +as in @code{(:source-registry-cache @emph{"foo/bar.asd" "path/to/more.asd" ...})}, +then the strings are assumed to be @code{unix-namestring}s designating +the available asd files under that tree, and the recursion otherwise stops. +The list can also be empty, allowing to stop a costly recursion in a huge directory tree. + +To update such a cache after you install, update or remove source repositories, +you can run a script distributed with ASDF: +@code{./tools/cl-source-registry-cache.lisp @emph{/path/to/directory}}. +To wholly invalidate the cache, you can +delete the file @file{.cl-source-registry.cache} in that directory. +In either case, for an existing Lisp process to see this change, +it needs to clear its own cache with e.g. @code{(asdf:clear-source-registry)}. + +Developers may safely create a cache in their development tree, +and we recommend they do it at the top of their source tree if +it contains more than a small number of files and directories; +they only need update it when they create, remove or move @file{.asd} files. +Software distribution managers may also safely create such a cache, +but they must be careful to update it every time they install, update or remove +a software source repository or installation package. +Finally, advanced developers who juggle with a lot of code +in their @code{source-registry} may manually manage such a cache, +to allow for faster startup of Lisp programs. +For instance, on one machine with hundreds of source repositories, +such a cache shaves half a second at the startup +of every @code{#!/usr/bin/cl} script, +which makes a difference as to their subjective interactivity and usability. + @node Configuration API, Introspection, Caching Results, Controlling where ASDF searches for systems @section Configuration API diff --git a/source-registry.lisp b/source-registry.lisp index d85285fdb052002cdd4a0602f035397121f01d34..7817d8d637dbf178d7c717e570844001614fe062 100644 --- a/source-registry.lisp +++ b/source-registry.lisp @@ -13,7 +13,7 @@ #:ensure-source-registry #:*source-registry-parameter* #:*default-source-registry-exclusions* #:*source-registry-exclusions* #:*wild-asd* #:directory-asd-files #:register-asd-directory - #:collect-asds-in-directory #:collect-sub*directories-asd-files + #:*recurse-beyond-asds* #:collect-asds-in-directory #:collect-sub*directories-asd-files #:validate-source-registry-directive #:validate-source-registry-form #:validate-source-registry-file #:validate-source-registry-directory #:parse-source-registry-string #:wrapping-source-registry @@ -59,15 +59,33 @@ system names to pathnames of .asd files") (directory-files directory *wild-asd*)) (defun collect-asds-in-directory (directory collect) - (map () collect (directory-asd-files directory))) + (let ((asds (directory-asd-files directory))) + (map () collect asds) + asds)) + + (defvar *recurse-beyond-asds* t + "Should :tree entries of the source-registry recurse in subdirectories +after having found a .asd file? True by default.") + + (defun process-source-registry-cache (directory collect) + (let ((cache (ignore-errors + (safe-read-file-form (subpathname directory ".cl-source-registry.cache"))))) + (when (and (listp cache) (eq :source-registry-cache (first cache))) + (loop :for s :in (rest cache) :do (funcall collect (subpathname directory s))) + t))) (defun collect-sub*directories-asd-files - (directory &key (exclude *default-source-registry-exclusions*) collect) + (directory &key (exclude *default-source-registry-exclusions*) collect + (recurse-beyond-asds *recurse-beyond-asds*) ignore-cache) (collect-sub*directories directory - (constantly t) - #'(lambda (x &aux (l (car (last (pathname-directory x))))) (not (member l exclude :test #'equal))) - #'(lambda (dir) (collect-asds-in-directory dir collect)))) + #'(lambda (dir) + (unless (and (not ignore-cache) (process-source-registry-cache directory collect)) + (let ((asds (collect-asds-in-directory dir collect))) + (or recurse-beyond-asds (not asds))))) + #'(lambda (x) + (not (member (car (last (pathname-directory x))) exclude :test #'equal))) + (constantly nil))) (defun validate-source-registry-directive (directive) (or (member directive '(:default-registry)) diff --git a/tools/cl-source-registry-cache.lisp b/tools/cl-source-registry-cache.lisp new file mode 100644 index 0000000000000000000000000000000000000000..59dd1ddf2219f7e078e6cf6f78c713928da2a0cf --- /dev/null +++ b/tools/cl-source-registry-cache.lisp @@ -0,0 +1,30 @@ +#!/usr/bin/cl -sp asdf -E main + +(in-package :asdf) + +(uiop-debug) + +(defun collect-asd (table asd) + (multiple-value-bind (previous foundp) + (gethash (pathname-name asd) table) + (when (or (not foundp) (< (length (pathname-directory previous)) + (length (pathname-directory asd)))) + (setf (gethash (pathname-name asd) table) asd)))) + +(defun update-cache (directory) + (let* ((dir (ensure-pathname directory + :namestring :native + :ensure-absolute t :want-non-wild t :ensure-directory t + :want-existing t)) + (table (make-hash-table :test 'equal))) + (collect-sub*directories-asd-files + dir :collect #'(lambda (asd) (collect-asd table asd)) :ignore-cache t) + (with-output-file (s (subpathname dir ".cl-source-registry.cache") + :if-exists :rename-and-delete :if-does-not-exist :create) + (format s "(:source-registry-cache~{~% ~S~})~%" + (sort (loop :for p :being :the :hash-values :of table + :collect (unix-namestring (enough-pathname p dir))) + 'string<))))) + +(defun main (argv) + (map () 'update-cache argv)) diff --git a/uiop/filesystem.lisp b/uiop/filesystem.lisp index dd016626a29632647ae720e62456eb16409d1dbd..08d3baa6173bb3ffc6c177963d025d1d49608278 100644 --- a/uiop/filesystem.lisp +++ b/uiop/filesystem.lisp @@ -263,8 +263,8 @@ permits this." :directory (append prefix (make-pathname-component-logical (last dir))))))))))) (defun collect-sub*directories (directory collectp recursep collector) - "Given a DIRECTORY, call-function the COLLECTOR function designator -on the directory if COLLECTP returns true when CALL-FUNCTION'ed with the directory, + "Given a DIRECTORY, when COLLECTP returns true when CALL-FUNCTION'ed with the directory, +call-function the COLLECTOR function designator on the directory, and recurse each of its subdirectories on which the RECURSEP returns true when CALL-FUNCTION'ed with them." (when (call-function collectp directory) (call-function collector directory) diff --git a/uiop/pathname.lisp b/uiop/pathname.lisp index 7d89b755f295cd874bfeb8449a0a8bd9f2aebe55..555b542d351eec585c8b27146ce4f79a656207b7 100644 --- a/uiop/pathname.lisp +++ b/uiop/pathname.lisp @@ -354,7 +354,7 @@ will be treated as part of the directory path. An empty string is thus read as meaning a pathname object with all fields nil. -Note that : characters will NOT be interpreted as host specification. +Note that colon characters #\: will NOT be interpreted as host specification. Absolute pathnames are only appropriate on Unix-style systems. The intention of this function is to support structured component names,