Package: emacs;
Reported by: Spencer Baugh <sbaugh <at> janestreet.com>
Date: Tue, 16 Sep 2025 16:52:02 UTC
Severity: normal
Tags: patch
Message #11 received at 79458 <at> debbugs.gnu.org (full text, mbox):
From: Spencer Baugh <sbaugh <at> janestreet.com> To: Stefan Monnier <monnier <at> iro.umontreal.ca> Cc: 79458 <at> debbugs.gnu.org Subject: Re: bug#79458: [PATCH] Call load-path-filter-function in Flocate_file_internal Date: Tue, 16 Sep 2025 17:38:06 -0400
[Message part 1 (text/plain, inline)]
Stefan Monnier <monnier <at> iro.umontreal.ca> writes:
>> From 30d3bdf9d6da9c77d529a292c0abe9f48be8d57b Mon Sep 17 00:00:00 2001
>> From: Spencer Baugh <sbaugh <at> janestreet.com>
>> Date: Tue, 16 Sep 2025 12:09:54 -0400
>> Subject: [PATCH] Call load-path-filter-function in Flocate_file_internal
>>
>> This allows calls like (locate-library "term/xterm") made by
>> tty-run-terminal-initialization to be optimized for long
>> load-paths.
>>
>> * lisp/startup.el (load-path-filter-cache-directory-files):
>> Filter on the directory of multi-component file names, and
>> handle nil PREFIXES.
>> * src/lread.c (Flocate_file_internal): Call
>> load-path-filter-function.
>> * test/lisp/startup-tests.el
>> (startup-tests/load-path-filter-cache-directory-files): Add.
>
> s/PREFIXES/SUFFIXES/?
Oops, yes, will fix in next version.
>> ---
>> lisp/startup.el | 52 +++++++++++++++++++++-----------------
>> src/lread.c | 2 ++
>> test/lisp/startup-tests.el | 12 +++++++++
>> 3 files changed, 43 insertions(+), 23 deletions(-)
>>
>> diff --git a/lisp/startup.el b/lisp/startup.el
>> index 836ead6deb0..5d824a0966e 100644
>> --- a/lisp/startup.el
>> +++ b/lisp/startup.el
>> @@ -1157,38 +1157,44 @@ load-path-filter-cache-directory-files
>> PATH should be a list of directories such as `load-path'.
>> Returns a copy of PATH with any directories that cannot contain FILE
>> with SUFFIXES removed from it.
>> -Doesn't filter PATH if FILE is an absolute file name or if FILE is
>> -a relative file name with leading directories.
>> +Doesn't filter PATH if FILE is an absolute file name.
>>
>> Caches contents of directories in `load-path-filter--cache'.
>>
>> This function is called from `load' via `load-path-filter-function'."
>> - (if (file-name-directory file)
>> - ;; FILE has more than one component, don't bother filtering.
>> + (if (or (file-name-absolute-p file)
>> + (string-empty-p file)
>> + (null suffixes)
>> + ;; Don't bother filtering if "" is among the suffixes.
>> + ;; It's a much less common use-case and it would use
>> + ;; more memory to keep the corresponding info.
>> + (member "" suffixes))
>> path
>> (pcase-let
>> ((`(,rx . ,ht)
>> (with-memoization (alist-get suffixes load-path-filter--cache
>> nil nil #'equal)
>> - (if (member "" suffixes)
>> - '(nil ;; Optimize the filtering.
>> - ;; Don't bother filtering if "" is among the suffixes.
>> - ;; It's a much less common use-case and it would use
>> - ;; more memory to keep the corresponding info.
>> - . nil)
>> - (cons (concat (regexp-opt suffixes) "\\'")
>> - (make-hash-table :test #'equal))))))
>> - (if (null ht)
>> - path
>> - (let ((completion-regexp-list nil))
>> - (seq-filter
>> - (lambda (dir)
>> - (when (file-directory-p dir)
>> - (try-completion
>> - file
>> - (with-memoization (gethash dir ht)
>> - (directory-files dir nil rx t)))))
>> - path))))))
>> + (cons (concat (regexp-opt (cons "/" suffixes)) "\\'")
>> + (make-hash-table :test #'equal)))))
>> + (let ((filter-on
>> + ;; Filter on the first component of FILE.
>> + (let ((split (file-name-split file)))
>> + (if (cdr split)
>> + ;; The first component must be a directory.
>> + (file-name-as-directory (car split))
>> + (car split))))
>> + (completion-regexp-list nil)
>> + (completion-ignore-case nil))
>> + (seq-filter
>> + (lambda (dir)
>> + (when (file-directory-p dir)
>> + (try-completion
>> + filter-on
>> + (with-memoization (gethash dir ht)
>> + (seq-filter
>> + (lambda (file) (string-match rx file))
>> + (file-name-all-completions "" dir))))))
>> + path)))))
>
> Have you compared the above `string-match` approach to letting
> `file-name-all-completions` do the regexp matching via
> `completion-regexp-list`?
Yes. Alas, completion-regexp-list is applied by
file-name-all-completions *before* the "/" is added to the file names of
directories. So using completion-regexp-list just didn't work :(
>> --- a/src/lread.c
>> +++ b/src/lread.c
>> @@ -1601,6 +1601,8 @@ DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2,
>> (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate)
>> {
>> Lisp_Object file;
>> + if (FUNCTIONP (Vload_path_filter_function))
>> + path = calln (Vload_path_filter_function, path, filename, suffixes);
>> int fd = openp (path, filename, suffixes, &file, predicate, false, true,
>> NULL);
>> if (NILP (predicate) && fd >= 0)
>
> Of course, this makes the name `load-path-filter-function` a lie since
> it applies to more than just `load-path`.
Yes. We probably should change the name.
> Have you tried to move the call directly into `openp`?
Just tried, it seems to work fine. The attached patch does that.
> Also, I wonder what's the impact on the size of the cache. I get the
> impression that we might be more likely to get duplicates because of
> slight variations of `suffixes`.
True.
What about just having a single cached list per directory, instead of
having separate lists pre-filtered with suffixes? That would avoid the
problem of duplication due to different suffixes. The attached patch
does that (in addition to moving the call to openp). I especially like
that it now works when "" is present as a suffix.
[0001-Call-load-path-filter-function-in-openp.patch (text/x-patch, inline)]
From 41ad123b8201325aa2e15dee84d8470c2eeb2933 Mon Sep 17 00:00:00 2001
From: Spencer Baugh <sbaugh <at> janestreet.com>
Date: Tue, 16 Sep 2025 12:09:54 -0400
Subject: [PATCH] Call load-path-filter-function in openp
This allows calls like (locate-library "term/xterm") made by
tty-run-terminal-initialization to be optimized for long
load-paths.
* lisp/startup.el (load-path-filter--cache): Update docstring;
this is now just a single hash-table.
(load-path-filter-cache-directory-files): Filter on the directory of
multi-component file names, and handle nil SUFFIXES. (bug#79458)
* src/lread.c (openp): Call load-path-filter-function.
* test/lisp/startup-tests.el
(startup-tests/load-path-filter-cache-directory-files): Add.
---
lisp/startup.el | 63 +++++++++++++++++---------------------
src/lread.c | 5 +--
test/lisp/startup-tests.el | 12 ++++++++
3 files changed, 43 insertions(+), 37 deletions(-)
diff --git a/lisp/startup.el b/lisp/startup.el
index 836ead6deb0..820b525a073 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1141,14 +1141,8 @@ lisp-directory
(defvar load-path-filter--cache nil
"A cache used by `load-path-filter-cache-directory-files'.
-The value 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 a regex matching those suffixes
-at the end of a string, and whose cdr is a hash-table mapping directories
-to files in those directories which end with one of the suffixes.
-These can also be nil, in which case no filtering will happen.
-The files named in the hash-table can be of any kind,
-including subdirectories.
+The value is a hash-table mapping directories to files in those
+directories. Subdirectories will end with a \"/\".
The hash-table uses `equal' as its key comparison function.")
(defun load-path-filter-cache-directory-files (path file suffixes)
@@ -1157,38 +1151,37 @@ load-path-filter-cache-directory-files
PATH should be a list of directories such as `load-path'.
Returns a copy of PATH with any directories that cannot contain FILE
with SUFFIXES removed from it.
-Doesn't filter PATH if FILE is an absolute file name or if FILE is
-a relative file name with leading directories.
+Doesn't filter PATH if FILE is an absolute file name.
Caches contents of directories in `load-path-filter--cache'.
This function is called from `load' via `load-path-filter-function'."
- (if (file-name-directory file)
- ;; FILE has more than one component, don't bother filtering.
+ (if (or (file-name-absolute-p file)
+ (string-empty-p file))
path
- (pcase-let
- ((`(,rx . ,ht)
- (with-memoization (alist-get suffixes load-path-filter--cache
- nil nil #'equal)
- (if (member "" suffixes)
- '(nil ;; Optimize the filtering.
- ;; Don't bother filtering if "" is among the suffixes.
- ;; It's a much less common use-case and it would use
- ;; more memory to keep the corresponding info.
- . nil)
- (cons (concat (regexp-opt suffixes) "\\'")
- (make-hash-table :test #'equal))))))
- (if (null ht)
- path
- (let ((completion-regexp-list nil))
- (seq-filter
- (lambda (dir)
- (when (file-directory-p dir)
- (try-completion
- file
- (with-memoization (gethash dir ht)
- (directory-files dir nil rx t)))))
- path))))))
+ (unless suffixes
+ (setq suffixes '("")))
+ (let ((filter-on
+ ;; Filter on the first component of FILE.
+ (let ((split (file-name-split file)))
+ (if (cdr split)
+ ;; The first component must be a directory.
+ (file-name-as-directory (car split))
+ (car split))))
+ (completion-regexp-list
+ (list (concat (regexp-opt (cons "/" suffixes)) "\\'")))
+ (completion-ignore-case nil))
+ (unless load-path-filter--cache
+ (setq load-path-filter--cache (make-hash-table :test #'equal)))
+ (seq-filter
+ (lambda (dir)
+ (when (file-directory-p dir)
+ (try-completion
+ filter-on
+ (with-memoization (gethash dir load-path-filter--cache)
+ (let ((completion-regexp-list nil))
+ (file-name-all-completions "" dir))))))
+ path))))
(defun command-line ()
"A subroutine of `normal-top-level'.
diff --git a/src/lread.c b/src/lread.c
index 1a667ce163a..fc470709931 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1205,8 +1205,6 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
}
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 (load_path, file, suffixes, &found, Qnil,
@@ -1794,6 +1792,9 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
absolute = complete_filename_p (str);
+ if (FUNCTIONP (Vload_path_filter_function))
+ path = calln (Vload_path_filter_function, path, str, suffixes);
+
AUTO_LIST1 (just_use_str, Qnil);
if (NILP (path))
path = just_use_str;
diff --git a/test/lisp/startup-tests.el b/test/lisp/startup-tests.el
index 59290ad4806..7b52a57b5bd 100644
--- a/test/lisp/startup-tests.el
+++ b/test/lisp/startup-tests.el
@@ -44,4 +44,16 @@ startup-tests/command-switch-alist
(should (equal foo-args '("--foo")))
(should (equal bar-args '("--bar=value")))))
+(ert-deftest startup-tests/load-path-filter-cache-directory-files ()
+ (should (locate-file "term/xterm" load-path '(".el")))
+ (should (locate-file "startup" load-path '(".el")))
+ (let ((load-path-filter-function #'load-path-filter-cache-directory-files)
+ load-path-filter--cache)
+ (should (load-path-filter-cache-directory-files load-path "startup" '(".el")))
+ (should (load-path-filter-cache-directory-files load-path "term/xterm" '(".el")))
+ (should (locate-file "term/xterm" load-path '(".el")))
+ (should (locate-file "startup" load-path '(".el")))
+ (should (locate-file "term/xterm.el" load-path))
+ (should (locate-file "startup.el" load-path))))
+
;;; startup-tests.el ends here
--
2.43.7
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.