GNU bug report logs - #79458
[PATCH] Call load-path-filter-function in Flocate_file_internal

Previous Next

To reply to this bug, email your comments to 79458 AT debbugs.gnu.org.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Spencer Baugh <sbaugh <at> janestreet.com>
To: bug-gnu-emacs <at> gnu.org
Subject: [PATCH] Call load-path-filter-function in Flocate_file_internal
Date: Tue, 16 Sep 2025 12:51:34 -0400

[Message part 1 (text/plain, inline)]

Tags: patch


See emacs-devel thread https://lists.gnu.org/archive/html/emacs-devel/2025-09/msg00389.html

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.

In GNU Emacs 30.1.90 (build 53, x86_64-pc-linux-gnu, X toolkit, cairo
 version 1.15.12, Xaw scroll bars) of 2025-09-12 built on
 igm-qws-u22796a
Repository revision: 40acab314a5c157ac30d65e6c7939f925c8205b7
Repository branch: emacs-30
Windowing system distributor 'The X.Org Foundation', version 11.0.12011000
System Description: Rocky Linux 8.10 (Green Obsidian)

Configured using:
 'configure --with-x-toolkit=lucid --without-gpm --without-gconf
 --without-selinux --without-imagemagick --with-modules --with-gif=no
 --with-cairo --with-rsvg --without-compress-install --with-tree-sitter
 --with-native-compilation=aot
 PKG_CONFIG_PATH=/usr/local/home/garnish/libtree-sitter/0.22.6-1/lib/pkgconfig/'

[0001-Call-load-path-filter-function-in-Flocate_file_inter.patch (text/patch, attachment)]

Message #8 received at 79458 <at> debbugs.gnu.org (full text, mbox):

From: Stefan Monnier <monnier <at> iro.umontreal.ca>
To: Spencer Baugh <sbaugh <at> janestreet.com>
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:02:45 -0400

> 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/?

> ---
>  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`?

> --- 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`.

Have you tried to move the call directly into `openp`?

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`.


        Stefan

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

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.