Add load-path-filter-function and use it to optimize loading

When there are many directories on load-path, the part of load which
searches load-path can become very slow.  By filtering load-path up
front to only contain directories which are likely to contain the
searched-for file, load becomes much faster.

This can be set in early-init.el for maximum effect.

* lisp/startup.el (load-path-filter--cache)
(load-path-filter-cache-directory-files): Add.
* src/lread.c (Fload): Call load-path-filter-function.
(syms_of_lread): Add load-path-filter-function.

(cherry picked from commit e5218df144203ff1b5da3d46b7579b6455008ee7)

diff --git a/lisp/startup.el b/lisp/startup.el
index 0c0dffa32f6f35c0842eb3bb3aeec7d9ef3ad735..29a04bef706d24edde3ecc6d349112b5b1c7ba0f 100644 (file)
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1097,6 +1097,39 @@ the `--debug-init' option to view a complete error backtrace."
 (defvar lisp-directory nil
   "Directory where Emacs's own *.el and *.elc Lisp files are installed.")
 
+(defvar load-path-filter--cache nil
+  "A cache used by `load-path-filter-cache-directory-files'.
+
+This is an alist.  The car of each entry is a list of load suffixes,
+such as returned by `get-load-suffixes'.  The cdr of each entry is a
+cons whose car is an optimized regex matching those suffixes at the end
+of a string, and whose cdr is a hashtable mapping directories to files
+in that directory which end with one of the suffixes.")
+
+(defun load-path-filter-cache-directory-files (path file suffixes)
+  "Filter PATH to only directories which might contain FILE with SUFFIXES.
+
+Doesn't filter if FILE is an absolute file name or if FILE is a relative
+file name with more than one component.
+
+Caches directory contents in `load-path-filter--cache'."
+  (if (file-name-directory file)
+      ;; FILE has more than one component, don't bother filtering.
+      path
+    (seq-filter
+     (let ((rx-and-ht
+            (with-memoization (alist-get suffixes load-path-filter--cache nil nil #'equal)
+              (cons
+               (concat (regexp-opt suffixes) "\\'")
+               (make-hash-table :test #'equal)))))
+       (lambda (dir)
+         (when (file-directory-p dir)
+           (try-completion
+            file
+            (with-memoization (gethash dir (cdr rx-and-ht))
+              (directory-files dir nil (car rx-and-ht) t))))))
+     path)))
+
 (defun command-line ()
   "A subroutine of `normal-top-level'.
 Amongst another things, it parses the command-line arguments."

diff --git a/src/lread.c b/src/lread.c
index 98cda8316ac9e2ed8f05751950f97813113de77d..ed481c197215c5376bcf4d116f8b026bb752ddf6 100644 (file)
--- a/src/lread.c
+++ b/src/lread.c
@@ -1424,12 +1424,16 @@ Return t if the file exists and loads successfully.  */)
            suffixes = CALLN (Fappend, suffixes, Vload_file_rep_suffixes);
        }
 
+      Lisp_Object load_path = Vload_path;
+      if (FUNCTIONP (Vload_path_filter_function))
+       load_path = calln (Vload_path_filter_function, load_path, file, suffixes);
+
 #if !defined USE_ANDROID_ASSETS
-      fd = openp (Vload_path, file, suffixes, &found, Qnil,
+      fd = openp (load_path, file, suffixes, &found, Qnil,
                  load_prefer_newer, no_native, NULL);
 #else
       asset = NULL;
-      rc = openp (Vload_path, file, suffixes, &found, Qnil,
+      rc = openp (load_path, file, suffixes, &found, Qnil,
                  load_prefer_newer, no_native, &asset);
       fd.fd = rc;
       fd.asset = asset;
@@ -6107,6 +6111,18 @@ where FILE is the filename of the eln file, including the .eln extension.
 through `require'.  */);
   load_no_native = false;
 
+  DEFVAR_LISP ("load-path-filter-function",
+              Vload_path_filter_function,
+              doc: /* Non-nil means to call this function to filter `load-path' for `load'.
+
+When load is called, this function is called with three arguments: the
+current value of `load-path' (a list of directories), the FILE argument
+to load, and the current load-suffixes.
+
+It should return a list of directories, which `load' will use instead of
+`load-path'.  */);
+  Vload_path_filter_function = Qnil;
+
   /* Vsource_directory was initialized in init_lread.  */
 
   DEFSYM (Qcurrent_load_list, "current-load-list");