feature/native-comp 7a8370e 2/2: * Add SELECTOR parameter to `native-compile-async' (bug#44813)

[Andrea Corallo]

branch: feature/native-comp
commit 7a8370ed0f1b1d62657e385789ee2f81c5607ec5
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>

    * Add SELECTOR parameter to `native-compile-async' (bug#44813)
    
    * lisp/emacs-lisp/comp.el (native-compile-async-skip-p): New function
    ripping out logic from `native--compile-async' and accounting for
    SELECTOR.
    (native--compile-async): Add SELECTOR parameter, make use of
    `native-compile-async-skip-p' and move it with other private
    functions.
    (native-compile-async): Add SELECTOR parameter.
---
 lisp/emacs-lisp/comp.el | 139 ++++++++++++++++++++++++++++--------------------
 1 file changed, 82 insertions(+), 57 deletions(-)

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 29a97a7..5313bfb 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -3439,53 +3439,26 @@ load once finished compiling."
       ;; So we return the compiled function.
       (native-elisp-load data))))
 
-
-;;; Compiler entry points.
-
-;;;###autoload
-(defun native-compile (function-or-file &optional output)
-  "Compile FUNCTION-OR-FILE into native code.
-This is the synchronous entry-point for the Emacs Lisp native
-compiler.
-FUNCTION-OR-FILE is a function symbol, a form or the filename of
-an Emacs Lisp source file.
-When OUTPUT is non-nil use it as filename for the compiled
-object.
-If FUNCTION-OR-FILE is a filename return the filename of the
-compiled object.  If FUNCTION-OR-FILE is a function symbol or a
-form return the compiled function."
-  (comp--native-compile function-or-file nil output))
-
-;;;###autoload
-(defun batch-native-compile ()
-  "Run `native-compile' on remaining command-line arguments.
-Ultra cheap impersonation of `batch-byte-compile'."
-  (comp-ensure-native-compiler)
-  (cl-loop for file in command-line-args-left
-           if (or (null byte-native-for-bootstrap)
-                  (cl-notany (lambda (re) (string-match re file))
-                             comp-bootstrap-deny-list))
-           do (comp--native-compile file)
-           else
-           do (byte-compile-file file)))
-
-;;;###autoload
-(defun batch-byte-native-compile-for-bootstrap ()
-  "As `batch-byte-compile' but used for booststrap.
-Generate .elc files in addition to the .eln one.  If the
-environment variable 'NATIVE_DISABLED' is set byte compile only."
-  (comp-ensure-native-compiler)
-  (if (equal (getenv "NATIVE_DISABLED") "1")
-      (batch-byte-compile)
-    (cl-assert (= 1 (length command-line-args-left)))
-    (let ((byte-native-for-bootstrap t)
-          (byte-to-native-output-file nil))
-      (batch-native-compile)
-      (pcase byte-to-native-output-file
-        (`(,tempfile . ,target-file)
-         (rename-file tempfile target-file t))))))
-
-(defun native--compile-async (paths &optional recursively load)
+(defun native-compile-async-skip-p (file load selector)
+  "Return non-nil when FILE compilation should be skipped.
+
+LOAD and SELECTOR work as described in `native--compile-async'."
+  ;; Make sure we are not already compiling `file' (bug#40838).
+  (or (gethash file comp-async-compilations)
+      (cond
+       ((null selector) nil)
+       ((functionp selector) (not (funcall selector file)))
+       ((stringp selector) (not (string-match-p selector file)))
+       (t (error "SELECTOR must be a function a regexp or nil")))
+      ;; Also exclude files from deferred compilation if
+      ;; any of the regexps in
+      ;; `comp-deferred-compilation-deny-list' matches.
+      (and (eq load 'late)
+           (cl-some (lambda (re)
+                      (string-match-p re file))
+                    comp-deferred-compilation-deny-list))))
+
+(defun native--compile-async (paths &optional recursively load selector)
   "Compile PATHS asynchronously.
 PATHS is one path or a list of paths to files or directories.
 
@@ -3495,6 +3468,12 @@ subdirectories of given directories.
 If optional argument LOAD is non-nil, request to load the file
 after compiling.
 
+The optional argument SELECTOR has the following valid values:
+
+nil -- Select all files.
+a string -- A regular expression selecting files with matching names.
+a function -- A function selecting files with matching names.
+
 The variable `comp-async-jobs-number' specifies the number
 of (commands) to run simultaneously.
 
@@ -3531,14 +3510,8 @@ bytecode definition was not changed in the meanwhile)."
                       (eq load (cdr entry)))
             (cl-substitute (cons file load) (car entry) comp-files-queue
                            :key #'car :test #'string=))
-        ;; Make sure we are not already compiling `file' (bug#40838).
-        (unless (or (gethash file comp-async-compilations)
-                    ;; Also exclude files from deferred compilation if
-                    ;; any of the regexps in
-                    ;; `comp-deferred-compilation-deny-list' matches.
-                    (and (eq load 'late)
-                         (cl-some (lambda (re) (string-match re file))
-                                  comp-deferred-compilation-deny-list)))
+
+        (unless (native-compile-async-skip-p file load selector)
           (let* ((out-filename (comp-el-to-eln-filename file))
                  (out-dir (file-name-directory out-filename)))
             (unless (file-exists-p out-dir)
@@ -3552,8 +3525,54 @@ bytecode definition was not changed in the meanwhile)."
     (when (zerop (comp-async-runnings))
       (comp-run-async-workers))))
 
+
+;;; Compiler entry points.
+
+;;;###autoload
+(defun native-compile (function-or-file &optional output)
+  "Compile FUNCTION-OR-FILE into native code.
+This is the synchronous entry-point for the Emacs Lisp native
+compiler.
+FUNCTION-OR-FILE is a function symbol, a form or the filename of
+an Emacs Lisp source file.
+When OUTPUT is non-nil use it as filename for the compiled
+object.
+If FUNCTION-OR-FILE is a filename return the filename of the
+compiled object.  If FUNCTION-OR-FILE is a function symbol or a
+form return the compiled function."
+  (comp--native-compile function-or-file nil output))
+
+;;;###autoload
+(defun batch-native-compile ()
+  "Run `native-compile' on remaining command-line arguments.
+Ultra cheap impersonation of `batch-byte-compile'."
+  (comp-ensure-native-compiler)
+  (cl-loop for file in command-line-args-left
+           if (or (null byte-native-for-bootstrap)
+                  (cl-notany (lambda (re) (string-match re file))
+                             comp-bootstrap-deny-list))
+           do (comp--native-compile file)
+           else
+           do (byte-compile-file file)))
+
+;;;###autoload
+(defun batch-byte-native-compile-for-bootstrap ()
+  "As `batch-byte-compile' but used for booststrap.
+Generate .elc files in addition to the .eln one.  If the
+environment variable 'NATIVE_DISABLED' is set byte compile only."
+  (comp-ensure-native-compiler)
+  (if (equal (getenv "NATIVE_DISABLED") "1")
+      (batch-byte-compile)
+    (cl-assert (= 1 (length command-line-args-left)))
+    (let ((byte-native-for-bootstrap t)
+          (byte-to-native-output-file nil))
+      (batch-native-compile)
+      (pcase byte-to-native-output-file
+        (`(,tempfile . ,target-file)
+         (rename-file tempfile target-file t))))))
+
 ;;;###autoload
-(defun native-compile-async (paths &optional recursively load)
+(defun native-compile-async (paths &optional recursively load selector)
   "Compile PATHS asynchronously.
 PATHS is one path or a list of paths to files or directories.
 
@@ -3563,11 +3582,17 @@ subdirectories of given directories.
 If optional argument LOAD is non-nil, request to load the file
 after compiling.
 
+The optional argument SELECTOR has the following valid values:
+
+nil -- Select all files.
+a string -- A regular expression selecting files with matching names.
+a function -- A function selecting files with matching names.
+
 The variable `comp-async-jobs-number' specifies the number
 of (commands) to run simultaneously."
   ;; Normalize: we only want to pass t or nil, never e.g. `late'.
   (let ((load (not (not load))))
-    (native--compile-async paths recursively load)))
+    (native--compile-async paths recursively load selector)))
 
 (provide 'comp)