all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* [feature/native-comp][PATCH] Minor improvements
@ 2020-03-14 22:12 Adam Porter
  2020-03-14 22:58 ` Adam Porter
  0 siblings, 1 reply; 3+ messages in thread
From: Adam Porter @ 2020-03-14 22:12 UTC (permalink / raw)
  To: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 389 bytes --]

Hi,

This patch makes some minor improvements to the feature/native-comp
branch, including renaming a few symbols, improving the usability of
some commands, improving some docstrings, and a few minor refactorings.
None of the compilation code is touched, only the UI and logging.
Andrea has approved this patch, and it's presented here for further
discussion before merging.

Thanks,
Adam

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Minor improvements to feature/native-comp branch --]
[-- Type: text/x-diff, Size: 13652 bytes --]

diff --git a/configure.ac b/configure.ac
index 0b2f5b6..393a53d 100644
--- a/configure.ac
+++ b/configure.ac
@@ -463,7 +463,7 @@ AC_DEFUN
 OPTION_DEFAULT_ON([zlib],[don't compile with zlib decompression support])
 OPTION_DEFAULT_ON([modules],[don't compile with dynamic modules support])
 OPTION_DEFAULT_ON([threads],[don't compile with elisp threading support])
-OPTION_DEFAULT_OFF([nativecomp],[don't compile with emacs lisp native compiler support])
+OPTION_DEFAULT_OFF([nativecomp],[compile with Emacs Lisp native compiler support])
 
 AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB],
  [use a file notification library (LIB one of: yes, inotify, kqueue, gfile, w32, no)])],
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 0779373..2ce530e 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -356,34 +356,44 @@ comp-add-const-to-relocs
   (puthash obj t (comp-data-container-idx (comp-alloc-class-to-container
                                            comp-curr-allocation-class))))
 
-(defmacro comp-within-log-buff (&rest body)
-  "Execute BODY while at the end the log-buffer.
-BODY is evaluate only if `comp-verbose' is > 0."
-  (declare (debug (form body))
-           (indent defun))
-  `(when (> comp-verbose 0)
-     (with-current-buffer (get-buffer-create comp-log-buffer-name)
-       (setf buffer-read-only t)
-       (let ((inhibit-read-only t))
-         (goto-char (point-max))
-         ,@body))))
-
-(defun comp-log (data verbosity)
-  "Log DATA given VERBOSITY."
-  (when (>= comp-verbose verbosity)
+(cl-defun comp-log (data &optional (level 1))
+  "Log DATA at LEVEL.
+LEVEL is a number from 1-3; if it is less than `comp-verbose', do
+nothing.  If `noninteractive', log with `message'.  Otherwise,
+log with `comp-log-to-buffer'."
+  (when (>= comp-verbose level)
     (if noninteractive
-        (if (atom data)
-            (message "%s" data)
-	  (mapc (lambda (x)
-                  (message "%s"(prin1-to-string x)))
-                data))
-      (comp-within-log-buff
-        (if (and data (atom data))
-            (insert data)
-          (mapc (lambda (x)
-                  (insert (prin1-to-string x) "\n"))
-                data)
-          (insert "\n"))))))
+        (cl-typecase data
+          (atom (message "%s" data))
+          (t (dolist (elem data)
+               (message "%s" elem))))
+      (comp-log-to-buffer data))))
+
+(cl-defun comp-log-to-buffer (data)
+  "Log DATA to `comp-log-buffer-name'."
+  (let* ((log-buffer
+          (or (get-buffer comp-log-buffer-name)
+              (with-current-buffer (get-buffer-create comp-log-buffer-name)
+                (setf buffer-read-only t)
+                (current-buffer))))
+         (log-window (get-buffer-window log-buffer))
+         (inhibit-read-only t)
+         at-end-p)
+    (with-current-buffer log-buffer
+      (when (= (point) (point-max))
+        (setf at-end-p t))
+      (save-excursion
+        (goto-char (point-max))
+        (cl-typecase data
+          (atom (princ data log-buffer))
+          (t (dolist (elem data)
+               (princ elem log-buffer)
+               (insert "\n"))))
+        (insert "\n"))
+      (when (and at-end-p log-window)
+        ;; When log window's point is at the end, follow the tail.
+        (with-selected-window log-window
+          (goto-char (point-max)))))))
 
 (defun comp-log-func (func verbosity)
   "Log function FUNC.
@@ -2052,105 +2062,108 @@ comp-hint-cons
 \f
 ;; Some entry point support code.
 
-(defvar comp-src-pool ()
-  "List containing the files to be compiled.")
-
-(defvar comp-prc-pool ()
-  "List containing all async compilation processes.")
-
-(defun comp-to-file-p (file)
-  "Return t if FILE has to be compiled."
-  (let ((compiled-f (concat file "n")))
-    (or comp-always-compile
-        (not (and (file-exists-p compiled-f)
-                  (file-newer-than-file-p compiled-f file))))))
-
-(cl-defun comp-start-async-worker ()
-  "Run an async compile worker."
-  (let (f)
-    (while (setf f (pop comp-src-pool))
-      (when (comp-to-file-p f)
-        (let* ((code `(progn
-                        (require 'comp)
-                        (setf comp-speed ,comp-speed
-                              comp-debug ,comp-debug
-                              comp-verbose ,comp-verbose
-                              load-path ',load-path)
-                        (message "Compiling %s started." ,f)
-                        (native-compile ,f))))
-          (push (make-process :name (concat "Compiling: " f)
-                              :buffer (get-buffer-create comp-async-buffer-name)
-                              :command (list (concat invocation-directory
-                                                     invocation-name)
-                                             "--batch"
-                                             "--eval"
-                                             (prin1-to-string code))
-                              :sentinel (lambda (prc _event)
-                                          (run-hook-with-args
-                                           'comp-async-cu-done-hook
-                                           f)
-                                          (accept-process-output prc)
-                                          (comp-start-async-worker)))
-                comp-prc-pool)
-          (cl-return-from comp-start-async-worker))))
-    (when (cl-notany #'process-live-p comp-prc-pool)
+(defvar comp-files-queue ()
+  "List of Elisp files to be compiled.")
+
+(defvar comp-async-processes ()
+  "List of running async compilation processes.")
+
+(defun comp-start-async-worker ()
+  "Start compiling files from `comp-files-queue' asynchronously.
+When compilation is finished, run `comp-async-all-done-hook' and
+display a message."
+  (if comp-files-queue
+      (cl-loop
+       for source-file = (pop comp-files-queue)
+       while source-file
+       do (cl-assert (string-match-p (rx ".el" eos) source-file) nil
+                     "`comp-files-queue' should be \".el\" files: %s"
+                     source-file)
+       when (or comp-always-compile
+                (file-newer-than-file-p source-file (concat source-file "n")))
+       do (let* ((expr `(progn
+                          (require 'comp)
+                          (setf comp-speed ,comp-speed
+                                comp-debug ,comp-debug
+                                comp-verbose ,comp-verbose
+                                load-path ',load-path)
+                          (message "Compiling %s..." ,source-file)
+                          (native-compile ,source-file)))
+                 (process (make-process
+                           :name (concat "Compiling: " source-file)
+                           :buffer (get-buffer-create comp-async-buffer-name)
+                           :command (list
+                                     (expand-file-name invocation-name
+                                                       invocation-directory)
+                                     "--batch" "--eval" (prin1-to-string expr))
+                           :sentinel (lambda (process _event)
+                                       (run-hook-with-args
+                                        'comp-async-cu-done-hook
+                                        source-file)
+                                       (accept-process-output process)
+                                       (comp-start-async-worker)))))
+            (push process comp-async-processes)))
+    ;; No files left to compile.
+    (when (cl-notany #'process-live-p comp-async-processes)
       (let ((msg "Compilation finished."))
-        (setf comp-prc-pool ())
+        (setf comp-async-processes ())
         (run-hooks 'comp-async-all-done-hook)
         (with-current-buffer (get-buffer-create comp-async-buffer-name)
           (save-excursion
             (goto-char (point-max))
             (insert msg "\n")))
         (message msg)))))
+
 \f
 ;;; Compiler entry points.
 
 ;;;###autoload
-(defun native-compile (input)
-  "Compile INPUT into native code.
+(defun native-compile (function-or-file)
+  "Compile FUNCTION-OR-FILE into native code.
 This is the entry-point for the Emacs Lisp native compiler.
-If INPUT is a symbol, native compile its function definition.
-If INPUT is a string, use it as the file path to be native compiled.
+FUNCTION-OR-FILE is a function symbol or a path to an Elisp file.
 Return the compilation unit file name."
-  (unless (or (symbolp input)
-              (stringp input))
+  (unless (or (functionp function-or-file)
+              (stringp function-or-file))
     (signal 'native-compiler-error
-          (list "not a symbol function or file" input)))
-  (let ((data input)
-        (comp-native-compiling t)
-        ;; Have the byte compiler signal an error when compilation
-        ;; fails.
-        (byte-compile-debug t)
-        (comp-ctxt (make-comp-ctxt
-                    :output
-                    (if (symbolp input)
-                        (make-temp-file (concat (symbol-name input) "-"))
-                      (let ((exp-file (expand-file-name input)))
-                        (cl-assert comp-native-path-postfix)
-                        (concat
-                         (file-name-as-directory
-                          (concat
-                           (file-name-directory exp-file)
-                           comp-native-path-postfix))
-                         (file-name-sans-extension
-                          (file-name-nondirectory exp-file))))))))
+            (list "Not a function symbol or file" function-or-file)))
+  (let* ((data function-or-file)
+         (comp-native-compiling t)
+         ;; Have byte compiler signal an error when compilation fails.
+         (byte-compile-debug t)
+         (comp-ctxt
+          (make-comp-ctxt
+           :output
+           (if (symbolp function-or-file)
+               (make-temp-file (concat (symbol-name function-or-file) "-"))
+             (let* ((expanded-filename (expand-file-name function-or-file))
+                    (output-dir (file-name-as-directory
+                                 (concat (file-name-directory expanded-filename)
+                                         comp-native-path-postfix)))
+                    (output-filename
+                     (file-name-sans-extension
+                      (file-name-nondirectory expanded-filename))))
+               (expand-file-name output-filename output-dir))))))
     (comp-log "\n\f\n" 1)
     (condition-case err
         (mapc (lambda (pass)
-                (comp-log (format "Running pass %s:\n" pass) 2)
+                (comp-log (format "(%s) Running pass %s:\n"
+                                  function-or-file pass)
+                          2)
                 (setf data (funcall pass data)))
               comp-passes)
       (native-compiler-error
        ;; Add source input.
        (let ((err-val (cdr err)))
-         (signal (car err) (if (consp err-val)
-                               (cons input err-val)
-                             (list input err-val))))))
+	 (signal (car err) (if (consp err-val)
+			       (cons function-or-file err-val)
+			     (list function-or-file err-val))))))
     data))
 
 ;;;###autoload
 (defun batch-native-compile ()
-  "Ultra cheap impersonation of `batch-byte-compile'."
+  "Run `native-compile' on remaining command-line arguments.
+Ultra cheap impersonation of `batch-byte-compile'."
   (mapc #'native-compile command-line-args-left))
 
 ;;;###autoload
@@ -2169,23 +2182,25 @@ batch-byte-native-compile-for-bootstrap
          (rename-file tempfile target-file t))))))
 
 ;;;###autoload
-(defun native-compile-async (input &optional jobs recursively)
-  "Compile INPUT asynchronously.
-INPUT can be either a list of files a folder or a file.
-JOBS specifies the number of jobs (commands) to run simultaneously (1 default).
-Follow folders RECURSIVELY if non nil."
-  (let ((jobs (or jobs 1))
-        (files (if (listp input)
-                   input
-                 (if (file-directory-p input)
-                     (if recursively
-                         (directory-files-recursively input "\\.el$")
-                       (directory-files input t "\\.el$"))
-                   (if (file-exists-p input)
-                       (list input)
-                     (signal 'native-compiler-error
-                             "input not a file nor directory"))))))
-    (setf comp-src-pool (nconc files comp-src-pool))
+(cl-defun native-compile-async (paths &optional (jobs 1) recursively)
+  "Compile PATHS asynchronously.
+PATHS is one path or a list of paths to files or directories.
+JOBS specifies the number of jobs (commands) to run
+simultaneously (1 default).  If RECURSIVELY, recurse into
+subdirectories of given directories."
+  (unless (listp paths)
+    (setf paths (list paths)))
+  (let (files)
+    (dolist (path paths)
+      (cond ((file-directory-p path)
+             (dolist (file (if recursively
+                               (directory-files-recursively path (rx ".el" eos))
+                             (directory-files path t (rx ".el" eos))))
+               (push file files)))
+            ((file-exists-p path) (push path files))
+            (t (signal 'native-compiler-error
+                       (list "Path not a file nor directory" path)))))
+    (setf comp-files-queue (nconc files comp-files-queue))
     (cl-loop repeat jobs
              do (comp-start-async-worker))
     (message "Compilation started.")))

^ permalink raw reply related	[flat|nested] 3+ messages in thread

* Re: [feature/native-comp][PATCH] Minor improvements
  2020-03-14 22:12 [feature/native-comp][PATCH] Minor improvements Adam Porter
@ 2020-03-14 22:58 ` Adam Porter
  2020-03-15 12:25   ` Andrea Corallo
  0 siblings, 1 reply; 3+ messages in thread
From: Adam Porter @ 2020-03-14 22:58 UTC (permalink / raw)
  To: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 564 bytes --]

Adam Porter <adam@alphapapa.net> writes:

> This patch makes some minor improvements to the feature/native-comp
> branch, including renaming a few symbols, improving the usability of
> some commands, improving some docstrings, and a few minor refactorings.
> None of the compilation code is touched, only the UI and logging.
> Andrea has approved this patch, and it's presented here for further
> discussion before merging.

Seems that I used the wrong command to produce that patch, as it is
missing the normal git headers.  Please see the attached patch instead.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: comp.el: Minor improvements --]
[-- Type: text/x-diff, Size: 15271 bytes --]

From 4c1b5049c64a9abde028577800a4de2692ac3056 Mon Sep 17 00:00:00 2001
From: Adam Porter <adam@alphapapa.net>
Date: Fri, 13 Mar 2020 00:42:49 +0000
Subject: [PATCH] comp.el: Minor improvements

Change: (comp-start-async-worker) Refactor slightly

Change: (comp-start-async-worker) Inline (comp-to-file-p)

Change: (comp-source-files) Rename from comp-src-pool

Add: (comp-start-async-worker) Assertion

Change: (comp-async-processes) Rename from comp-prc-pool

Tidy: (native-compile)

Rename variables, improve docstring, adjust log message, simplify
filename code.

Tidy: (batch-native-compile) Docstring

Tidy: whitespace-cleanup

Tidy: (comp-start-async-worker) Use () instead of nil

Tidy: (comp-files-queue) Rename from comp-source-files

Change: (native-compile-async) Improve paths support

Tidy: Comment

Save a line for one word.  :)

Change: (comp-log) Rewrite without macro, follow tail

Change: (native-compile-async) Use end-of-string in filename regexps

Change: (native-compile-async) Use cl-loop instead of dotimes

Add/Change: (comp-log-to-buffer) And use in comp-log

Comment: Tidy comment

Fix: (configure.ac) Option description

Fix: (comp-log) Argument

Fix: (comp-start-async-worker) Variable name

Change: Undo whitespace changes

Some of them included incorrect indentation because the
macros' (declare (indent)) forms were not loaded.  The
whitespace-cleanup should be run from Emacs 27+ with the file loaded.
---
 configure.ac            |   2 +-
 lisp/emacs-lisp/comp.el | 249 +++++++++++++++++++++++++-----------------------
 2 files changed, 133 insertions(+), 118 deletions(-)

diff --git a/configure.ac b/configure.ac
index 0b2f5b6..393a53d 100644
--- a/configure.ac
+++ b/configure.ac
@@ -463,7 +463,7 @@ AC_DEFUN
 OPTION_DEFAULT_ON([zlib],[don't compile with zlib decompression support])
 OPTION_DEFAULT_ON([modules],[don't compile with dynamic modules support])
 OPTION_DEFAULT_ON([threads],[don't compile with elisp threading support])
-OPTION_DEFAULT_OFF([nativecomp],[don't compile with emacs lisp native compiler support])
+OPTION_DEFAULT_OFF([nativecomp],[compile with Emacs Lisp native compiler support])
 
 AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB],
  [use a file notification library (LIB one of: yes, inotify, kqueue, gfile, w32, no)])],
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 0779373..2ce530e 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -356,34 +356,44 @@ comp-add-const-to-relocs
   (puthash obj t (comp-data-container-idx (comp-alloc-class-to-container
                                            comp-curr-allocation-class))))
 
-(defmacro comp-within-log-buff (&rest body)
-  "Execute BODY while at the end the log-buffer.
-BODY is evaluate only if `comp-verbose' is > 0."
-  (declare (debug (form body))
-           (indent defun))
-  `(when (> comp-verbose 0)
-     (with-current-buffer (get-buffer-create comp-log-buffer-name)
-       (setf buffer-read-only t)
-       (let ((inhibit-read-only t))
-         (goto-char (point-max))
-         ,@body))))
-
-(defun comp-log (data verbosity)
-  "Log DATA given VERBOSITY."
-  (when (>= comp-verbose verbosity)
+(cl-defun comp-log (data &optional (level 1))
+  "Log DATA at LEVEL.
+LEVEL is a number from 1-3; if it is less than `comp-verbose', do
+nothing.  If `noninteractive', log with `message'.  Otherwise,
+log with `comp-log-to-buffer'."
+  (when (>= comp-verbose level)
     (if noninteractive
-        (if (atom data)
-            (message "%s" data)
-	  (mapc (lambda (x)
-                  (message "%s"(prin1-to-string x)))
-                data))
-      (comp-within-log-buff
-        (if (and data (atom data))
-            (insert data)
-          (mapc (lambda (x)
-                  (insert (prin1-to-string x) "\n"))
-                data)
-          (insert "\n"))))))
+        (cl-typecase data
+          (atom (message "%s" data))
+          (t (dolist (elem data)
+               (message "%s" elem))))
+      (comp-log-to-buffer data))))
+
+(cl-defun comp-log-to-buffer (data)
+  "Log DATA to `comp-log-buffer-name'."
+  (let* ((log-buffer
+          (or (get-buffer comp-log-buffer-name)
+              (with-current-buffer (get-buffer-create comp-log-buffer-name)
+                (setf buffer-read-only t)
+                (current-buffer))))
+         (log-window (get-buffer-window log-buffer))
+         (inhibit-read-only t)
+         at-end-p)
+    (with-current-buffer log-buffer
+      (when (= (point) (point-max))
+        (setf at-end-p t))
+      (save-excursion
+        (goto-char (point-max))
+        (cl-typecase data
+          (atom (princ data log-buffer))
+          (t (dolist (elem data)
+               (princ elem log-buffer)
+               (insert "\n"))))
+        (insert "\n"))
+      (when (and at-end-p log-window)
+        ;; When log window's point is at the end, follow the tail.
+        (with-selected-window log-window
+          (goto-char (point-max)))))))
 
 (defun comp-log-func (func verbosity)
   "Log function FUNC.
@@ -2052,105 +2062,108 @@ comp-hint-cons
 \f
 ;; Some entry point support code.
 
-(defvar comp-src-pool ()
-  "List containing the files to be compiled.")
-
-(defvar comp-prc-pool ()
-  "List containing all async compilation processes.")
-
-(defun comp-to-file-p (file)
-  "Return t if FILE has to be compiled."
-  (let ((compiled-f (concat file "n")))
-    (or comp-always-compile
-        (not (and (file-exists-p compiled-f)
-                  (file-newer-than-file-p compiled-f file))))))
-
-(cl-defun comp-start-async-worker ()
-  "Run an async compile worker."
-  (let (f)
-    (while (setf f (pop comp-src-pool))
-      (when (comp-to-file-p f)
-        (let* ((code `(progn
-                        (require 'comp)
-                        (setf comp-speed ,comp-speed
-                              comp-debug ,comp-debug
-                              comp-verbose ,comp-verbose
-                              load-path ',load-path)
-                        (message "Compiling %s started." ,f)
-                        (native-compile ,f))))
-          (push (make-process :name (concat "Compiling: " f)
-                              :buffer (get-buffer-create comp-async-buffer-name)
-                              :command (list (concat invocation-directory
-                                                     invocation-name)
-                                             "--batch"
-                                             "--eval"
-                                             (prin1-to-string code))
-                              :sentinel (lambda (prc _event)
-                                          (run-hook-with-args
-                                           'comp-async-cu-done-hook
-                                           f)
-                                          (accept-process-output prc)
-                                          (comp-start-async-worker)))
-                comp-prc-pool)
-          (cl-return-from comp-start-async-worker))))
-    (when (cl-notany #'process-live-p comp-prc-pool)
+(defvar comp-files-queue ()
+  "List of Elisp files to be compiled.")
+
+(defvar comp-async-processes ()
+  "List of running async compilation processes.")
+
+(defun comp-start-async-worker ()
+  "Start compiling files from `comp-files-queue' asynchronously.
+When compilation is finished, run `comp-async-all-done-hook' and
+display a message."
+  (if comp-files-queue
+      (cl-loop
+       for source-file = (pop comp-files-queue)
+       while source-file
+       do (cl-assert (string-match-p (rx ".el" eos) source-file) nil
+                     "`comp-files-queue' should be \".el\" files: %s"
+                     source-file)
+       when (or comp-always-compile
+                (file-newer-than-file-p source-file (concat source-file "n")))
+       do (let* ((expr `(progn
+                          (require 'comp)
+                          (setf comp-speed ,comp-speed
+                                comp-debug ,comp-debug
+                                comp-verbose ,comp-verbose
+                                load-path ',load-path)
+                          (message "Compiling %s..." ,source-file)
+                          (native-compile ,source-file)))
+                 (process (make-process
+                           :name (concat "Compiling: " source-file)
+                           :buffer (get-buffer-create comp-async-buffer-name)
+                           :command (list
+                                     (expand-file-name invocation-name
+                                                       invocation-directory)
+                                     "--batch" "--eval" (prin1-to-string expr))
+                           :sentinel (lambda (process _event)
+                                       (run-hook-with-args
+                                        'comp-async-cu-done-hook
+                                        source-file)
+                                       (accept-process-output process)
+                                       (comp-start-async-worker)))))
+            (push process comp-async-processes)))
+    ;; No files left to compile.
+    (when (cl-notany #'process-live-p comp-async-processes)
       (let ((msg "Compilation finished."))
-        (setf comp-prc-pool ())
+        (setf comp-async-processes ())
         (run-hooks 'comp-async-all-done-hook)
         (with-current-buffer (get-buffer-create comp-async-buffer-name)
           (save-excursion
             (goto-char (point-max))
             (insert msg "\n")))
         (message msg)))))
+
 \f
 ;;; Compiler entry points.
 
 ;;;###autoload
-(defun native-compile (input)
-  "Compile INPUT into native code.
+(defun native-compile (function-or-file)
+  "Compile FUNCTION-OR-FILE into native code.
 This is the entry-point for the Emacs Lisp native compiler.
-If INPUT is a symbol, native compile its function definition.
-If INPUT is a string, use it as the file path to be native compiled.
+FUNCTION-OR-FILE is a function symbol or a path to an Elisp file.
 Return the compilation unit file name."
-  (unless (or (symbolp input)
-              (stringp input))
+  (unless (or (functionp function-or-file)
+              (stringp function-or-file))
     (signal 'native-compiler-error
-          (list "not a symbol function or file" input)))
-  (let ((data input)
-        (comp-native-compiling t)
-        ;; Have the byte compiler signal an error when compilation
-        ;; fails.
-        (byte-compile-debug t)
-        (comp-ctxt (make-comp-ctxt
-                    :output
-                    (if (symbolp input)
-                        (make-temp-file (concat (symbol-name input) "-"))
-                      (let ((exp-file (expand-file-name input)))
-                        (cl-assert comp-native-path-postfix)
-                        (concat
-                         (file-name-as-directory
-                          (concat
-                           (file-name-directory exp-file)
-                           comp-native-path-postfix))
-                         (file-name-sans-extension
-                          (file-name-nondirectory exp-file))))))))
+            (list "Not a function symbol or file" function-or-file)))
+  (let* ((data function-or-file)
+         (comp-native-compiling t)
+         ;; Have byte compiler signal an error when compilation fails.
+         (byte-compile-debug t)
+         (comp-ctxt
+          (make-comp-ctxt
+           :output
+           (if (symbolp function-or-file)
+               (make-temp-file (concat (symbol-name function-or-file) "-"))
+             (let* ((expanded-filename (expand-file-name function-or-file))
+                    (output-dir (file-name-as-directory
+                                 (concat (file-name-directory expanded-filename)
+                                         comp-native-path-postfix)))
+                    (output-filename
+                     (file-name-sans-extension
+                      (file-name-nondirectory expanded-filename))))
+               (expand-file-name output-filename output-dir))))))
     (comp-log "\n\f\n" 1)
     (condition-case err
         (mapc (lambda (pass)
-                (comp-log (format "Running pass %s:\n" pass) 2)
+                (comp-log (format "(%s) Running pass %s:\n"
+                                  function-or-file pass)
+                          2)
                 (setf data (funcall pass data)))
               comp-passes)
       (native-compiler-error
        ;; Add source input.
        (let ((err-val (cdr err)))
-         (signal (car err) (if (consp err-val)
-                               (cons input err-val)
-                             (list input err-val))))))
+	 (signal (car err) (if (consp err-val)
+			       (cons function-or-file err-val)
+			     (list function-or-file err-val))))))
     data))
 
 ;;;###autoload
 (defun batch-native-compile ()
-  "Ultra cheap impersonation of `batch-byte-compile'."
+  "Run `native-compile' on remaining command-line arguments.
+Ultra cheap impersonation of `batch-byte-compile'."
   (mapc #'native-compile command-line-args-left))
 
 ;;;###autoload
@@ -2169,23 +2182,25 @@ batch-byte-native-compile-for-bootstrap
          (rename-file tempfile target-file t))))))
 
 ;;;###autoload
-(defun native-compile-async (input &optional jobs recursively)
-  "Compile INPUT asynchronously.
-INPUT can be either a list of files a folder or a file.
-JOBS specifies the number of jobs (commands) to run simultaneously (1 default).
-Follow folders RECURSIVELY if non nil."
-  (let ((jobs (or jobs 1))
-        (files (if (listp input)
-                   input
-                 (if (file-directory-p input)
-                     (if recursively
-                         (directory-files-recursively input "\\.el$")
-                       (directory-files input t "\\.el$"))
-                   (if (file-exists-p input)
-                       (list input)
-                     (signal 'native-compiler-error
-                             "input not a file nor directory"))))))
-    (setf comp-src-pool (nconc files comp-src-pool))
+(cl-defun native-compile-async (paths &optional (jobs 1) recursively)
+  "Compile PATHS asynchronously.
+PATHS is one path or a list of paths to files or directories.
+JOBS specifies the number of jobs (commands) to run
+simultaneously (1 default).  If RECURSIVELY, recurse into
+subdirectories of given directories."
+  (unless (listp paths)
+    (setf paths (list paths)))
+  (let (files)
+    (dolist (path paths)
+      (cond ((file-directory-p path)
+             (dolist (file (if recursively
+                               (directory-files-recursively path (rx ".el" eos))
+                             (directory-files path t (rx ".el" eos))))
+               (push file files)))
+            ((file-exists-p path) (push path files))
+            (t (signal 'native-compiler-error
+                       (list "Path not a file nor directory" path)))))
+    (setf comp-files-queue (nconc files comp-files-queue))
     (cl-loop repeat jobs
              do (comp-start-async-worker))
     (message "Compilation started.")))
-- 
2.7.4


^ permalink raw reply related	[flat|nested] 3+ messages in thread

* Re: [feature/native-comp][PATCH] Minor improvements
  2020-03-14 22:58 ` Adam Porter
@ 2020-03-15 12:25   ` Andrea Corallo
  0 siblings, 0 replies; 3+ messages in thread
From: Andrea Corallo @ 2020-03-15 12:25 UTC (permalink / raw)
  To: Adam Porter; +Cc: emacs-devel

Adam Porter <adam@alphapapa.net> writes:

> Adam Porter <adam@alphapapa.net> writes:
>
>> This patch makes some minor improvements to the feature/native-comp
>> branch, including renaming a few symbols, improving the usability of
>> some commands, improving some docstrings, and a few minor refactorings.
>> None of the compilation code is touched, only the UI and logging.
>> Andrea has approved this patch, and it's presented here for further
>> discussion before merging.
>
> Seems that I used the wrong command to produce that patch, as it is
> missing the normal git headers.  Please see the attached patch instead.

Hi Adam,

thanks for working on this clean-up job, this is now pushed.

I think next around that would be your point of doing a better job
reporting async compilation errors.

After that we'll have to give the user a better visibility/control over
the async compilation queue.  With the deferred compilation (I started
working on) the async queue will be an hot-spot (especially in case not
all Emacs gets native compiled by make).

Thanks

  Andrea

--
akrl@sdf.org



^ permalink raw reply	[flat|nested] 3+ messages in thread

end of thread, other threads:[~2020-03-15 12:25 UTC | newest]

Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2020-03-14 22:12 [feature/native-comp][PATCH] Minor improvements Adam Porter
2020-03-14 22:58 ` Adam Porter
2020-03-15 12:25   ` Andrea Corallo

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.