[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

feature/native-comp 46a4ca4 1/4: comp.el: Minor improvements

From: Andrea Corallo
Subject: feature/native-comp 46a4ca4 1/4: comp.el: Minor improvements
Date: Sun, 15 Mar 2020 08:10:37 -0400 (EDT)

branch: feature/native-comp
commit 46a4ca4774e27f76c93277db187df31aa6e1cf2e
Author: Adam Porter <address@hidden>
Commit: Andrea Corallo <address@hidden>

    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 @@ OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS 
 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 
+OPTION_DEFAULT_OFF([nativecomp],[compile with Emacs Lisp native compiler 
  [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 @@ Assume allocaiton class 'd-default as default."
   (puthash obj t (comp-data-container-idx (comp-alloc-class-to-container
-(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 @@ Prepare every function for final compilation and 
drive the C back-end."
 ;; 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 
-                              :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)
             (goto-char (point-max))
             (insert msg "\n")))
         (message msg)))))
 ;;; Compiler entry points.
-(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 
+                                         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\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)))
        ;; 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))))))
 (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))
@@ -2169,23 +2182,25 @@ Always generate elc files too and handle native 
compiler expected errors."
          (rename-file tempfile target-file t))))))
-(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" 
+                             (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.")))

reply via email to

[Prev in Thread] Current Thread [Next in Thread]