commit 0992335d128f6fc2ac1b5abc4f4106e58110a6da (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Sat Jul 31 09:28:36 2021 +0300 * src/fontset.c (check_fontset_name): A better fix for bug#49782. diff --git a/src/fontset.c b/src/fontset.c index d2d428da2e..7d4bd65f70 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1356,15 +1356,16 @@ check_fontset_name (Lisp_Object name, Lisp_Object *frame) int id; struct frame *f = decode_live_frame (*frame); - if (!FRAME_WINDOW_P (f) && !FRAME_INITIAL_P (f)) - error ("Can't use fontsets in non-GUI frames"); - XSETFRAME (*frame, f); if (EQ (name, Qt)) return Vdefault_fontset; if (NILP (name)) - id = FRAME_FONTSET (f); + { + if (!FRAME_WINDOW_P (f)) + error ("Can't use fontsets in non-GUI frames"); + id = FRAME_FONTSET (f); + } else { CHECK_STRING (name); commit 44fe0043d3671676867f302865b15bc3d90217b9 Author: Adam Porter Date: Mon Mar 9 13:01:32 2020 -0500 * lisp/emacs-lisp/cl-macs.el: Add cl-type pattern * lisp/emacs-lisp/cl-macs.el: ((pcase-defmacro type)): Add 'cl-type' pattern. * test/lisp/emacs-lisp/pcase-tests.el (pcase-tests-cl-type): Add test. * doc/lispref/control.texi (pcase Macro): Update manual. With thanks to Stefan Monnier and Eli Zaretskii for their guidance. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 22b665bc93..5026d0a4d7 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -555,6 +555,16 @@ Two symbols to avoid are @code{t}, which behaves like @code{_} Likewise, it makes no sense to bind keyword symbols (@pxref{Constant Variables}). +@item (cl-type @var{type}) +Matches if @var{expval} is of type @var{type}, which is a type +descriptor as accepted by @code{cl-typep} (@pxref{cl-typep,,,cl,Common +Lisp Extensions}). Examples: + +@lisp +(cl-type integer) +(cl-type (integer 0 10)) +@end lisp + @item (pred @var{function}) Matches if the predicate @var{function} returns non-@code{nil} when called on @var{expval}. The test can be negated with the syntax diff --git a/etc/NEWS b/etc/NEWS index 36dc98d8c0..ef115d0ae0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -545,6 +545,11 @@ in better code. --- *** New function 'pcase-compile-patterns' to write other macros. +*** Added 'cl-type' pattern. +The new 'cl-type' pattern compares types using 'cl-typep', which allows +comparing simple types like '(cl-type integer)', as well as forms like +'(cl-type (integer 0 10))'. + +++ ** profiler.el The results displayed by 'profiler-report' now have the usage figures diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index cff4368940..caf8bba2f8 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3623,6 +3623,14 @@ STRUCT and SLOT-NAME are symbols. INST is a structure instance." "use `with-eval-after-load' instead." "28.1") (run-hooks 'cl-macs-load-hook) +;;; Pcase type pattern. + +;;;###autoload +(pcase-defmacro cl-type (type) + "Pcase pattern that matches objects of TYPE. +TYPE is a type descriptor as accepted by `cl-typep', which see." + `(pred (pcase--flip cl-typep ',type))) + ;; Local variables: ;; generated-autoload-file: "cl-loaddefs.el" ;; End: diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el index 2120139ec1..02d3878ad0 100644 --- a/test/lisp/emacs-lisp/pcase-tests.el +++ b/test/lisp/emacs-lisp/pcase-tests.el @@ -100,4 +100,14 @@ (should (equal (funcall f 'b1) '(4 5 nil nil))) (should (equal (funcall f 'b2) '(nil nil 8 9))))) +(ert-deftest pcase-tests-cl-type () + (should (equal (pcase 1 + ((cl-type integer) 'integer)) + 'integer)) + (should (equal (pcase 1 + ((cl-type (integer 0 2)) 'integer-0<=n<=2)) + 'integer-0<=n<=2)) + (should-error (pcase 1 + ((cl-type notatype) 'integer)))) + ;;; pcase-tests.el ends here. commit d9bc7dbefd88995d04b9843f521d82118265fecf Author: Eli Zaretskii Date: Fri Jul 30 21:51:59 2021 +0300 * src/fontset.c (check_fontset_name): Fix last change. diff --git a/src/fontset.c b/src/fontset.c index 52c7e381e1..d2d428da2e 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1356,7 +1356,7 @@ check_fontset_name (Lisp_Object name, Lisp_Object *frame) int id; struct frame *f = decode_live_frame (*frame); - if (!FRAME_WINDOW_P (f)) + if (!FRAME_WINDOW_P (f) && !FRAME_INITIAL_P (f)) error ("Can't use fontsets in non-GUI frames"); XSETFRAME (*frame, f); commit 1da5b2c60b6ad3747046cbe9060d35a6d110a97c Author: Eli Zaretskii Date: Fri Jul 30 21:17:58 2021 +0300 Avoid segfault when set-fontset-font is called from non-GUI frames * src/fontset.c (check_fontset_name): Avoid crashes if this is called from a non-GUI frame. (Bug#49782) diff --git a/src/fontset.c b/src/fontset.c index 332be6c39d..52c7e381e1 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1356,6 +1356,9 @@ check_fontset_name (Lisp_Object name, Lisp_Object *frame) int id; struct frame *f = decode_live_frame (*frame); + if (!FRAME_WINDOW_P (f)) + error ("Can't use fontsets in non-GUI frames"); + XSETFRAME (*frame, f); if (EQ (name, Qt)) commit 55a9c17cef78b1fd3da42bcc2ab55d4acbaa24eb Author: Michael Albinus Date: Fri Jul 30 17:19:29 2021 +0200 Change Tramp version to "2.5.2-pre" * doc/misc/trampver.texi: * lisp/net/trampver.el: Change version to "2.5.2-pre". diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 10c951d3cc..b11ee39f88 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -8,7 +8,7 @@ @c In the Tramp GIT, the version numbers are auto-frobbed from @c tramp.el, and the bug report address is auto-frobbed from @c configure.ac. -@set trampver 2.5.1 +@set trampver 2.5.2-pre @set trampurl https://www.gnu.org/software/tramp/ @set tramp-bug-report-address tramp-devel@@gnu.org @set emacsver 25.1 diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index e6cf4c6ac5..8ad641ee45 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.5.1 +;; Version: 2.5.2-pre ;; Package-Requires: ((emacs "25.1")) ;; Package-Type: multi ;; URL: https://www.gnu.org/software/tramp/ @@ -40,7 +40,7 @@ ;; ./configure" to change them. ;;;###tramp-autoload -(defconst tramp-version "2.5.1" +(defconst tramp-version "2.5.2-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -76,7 +76,7 @@ ;; Check for Emacs version. (let ((x (if (not (string-lessp emacs-version "25.1")) "ok" - (format "Tramp 2.5.1 is not fit for %s" + (format "Tramp 2.5.2-pre is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) commit 3f70e8560958a2fe648c9536380d1f8bf804d07d Author: Stephen Gildea Date: Fri Jul 30 06:32:41 2021 -0700 ; fix 2 typos in MH-E comments * lisp/mh-e/ChangeLog.1: fix typo * lisp/mh-e/mh-junk.el (mh-junk-allowlist): fix verb tense diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1 index f1aeca6547..b0fdd02e3b 100644 --- a/lisp/mh-e/ChangeLog.1 +++ b/lisp/mh-e/ChangeLog.1 @@ -11196,7 +11196,7 @@ instead of "0 msgs". Do not try to print a range when there are no messages. * mh-e.el (mh-regenerate-headers): Bug fix. Catch and remove the - "scan: band message list" message. + "scan: bad message list" message. 2001-11-13 Jeffrey C Honig diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el index cf9cf721e0..0890cb6839 100644 --- a/lisp/mh-e/mh-junk.el +++ b/lisp/mh-e/mh-junk.el @@ -118,7 +118,7 @@ message(s) as specified by the option `mh-junk-disposition'." (defun mh-junk-allowlist (range) "Allowlist RANGE as ham. -This command reclassifies the RANGE as ham if it were incorrectly +This command reclassifies the RANGE as ham if it has been incorrectly classified as spam (see the option `mh-junk-program'). It then refiles the message into the \"+inbox\" folder. commit df1dbaf121703aebae83d2725b7aed8b961f2913 Author: Dmitry Gutov Date: Fri Jul 30 14:58:25 2021 +0200 Make fileloop skip missing files * lisp/fileloop.el (fileloop-next-file): If a file doesn't exist, skip to the next one (bug#44979). diff --git a/etc/NEWS b/etc/NEWS index d378a81890..36dc98d8c0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2340,6 +2340,9 @@ This command, called interactively, toggles the local value of ** Miscellaneous +--- +*** fileloop will now skip missing files instead of signalling an error. + +++ *** ".dir-locals.el" now supports setting 'auto-mode-alist'. The new 'auto-mode-alist' specification in ".dir-locals.el" files can diff --git a/lisp/fileloop.el b/lisp/fileloop.el index 8a2755d69a..45b9cea939 100644 --- a/lisp/fileloop.el +++ b/lisp/fileloop.el @@ -120,7 +120,10 @@ operating on the next file and nil otherwise." (kill-all-local-variables) (erase-buffer) (setq new next) - (insert-file-contents new nil)) + (condition-case nil + (insert-file-contents new nil) + (file-missing + (fileloop-next-file novisit)))) new))) (defun fileloop-continue () commit ce8d5c6fa5c9966f2507d5299ac9dc5e2db33aa3 Author: Maxim Nikulin Date: Fri Jul 30 14:42:07 2021 +0200 Tweak previous mailcap-view-file change * lisp/net/mailcap.el (mailcap-view-file): Remove the :noquery t mistakenly added (bug#12972). Copyright-paperwork-exempt: yes diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index f64897ac9b..aeeb9bd8d3 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -1186,7 +1186,6 @@ See \"~/.mailcap\", `mailcap-mime-data' and related files and variables." (make-process :name "mailcap-view-file" :connection-type 'pipe - :noquery t :buffer nil ; "*Messages*" may be suitable for debugging :sentinel (lambda (proc event) (when (and (memq (process-status proc) '(exit signal)) commit 9ffbe99b119d032c4d62e422abf7cf6d78ecfdf5 Author: k3tu0isui Date: Fri Jul 30 14:39:13 2021 +0200 Fix problem when switching between different prolog versions * lisp/progmodes/prolog.el (run-prolog): Make switching between different prolog systems work more reliably (bug#45795). * lisp/progmodes/prolog.el (prolog-ensure-process): Don't start a new process if one already exists. Copyright-paperwork-exempt: yes diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 29cce51e22..0b520e3907 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -1315,6 +1315,7 @@ With prefix argument ARG, restart the Prolog process if running before." (progn (process-send-string "prolog" "halt.\n") (while (get-process "prolog") (sit-for 0.1)))) + (prolog-ensure-process) (let ((buff (buffer-name))) (if (not (string= buff "*prolog*")) (prolog-goto-prolog-process-buffer)) @@ -1324,7 +1325,6 @@ With prefix argument ARG, restart the Prolog process if running before." prolog-use-sicstus-sd) (prolog-enable-sicstus-sd)) (prolog-mode-variables) - (prolog-ensure-process) )) (defun prolog-inferior-guess-flavor (&optional ignored) @@ -1349,56 +1349,57 @@ With prefix argument ARG, restart the Prolog process if running before." "If Prolog process is not running, run it. If the optional argument WAIT is non-nil, wait for Prolog prompt specified by the variable `prolog-prompt-regexp'." - (if (null (prolog-program-name)) - (error "This Prolog system has defined no interpreter.")) - (if (comint-check-proc "*prolog*") - () - (with-current-buffer (get-buffer-create "*prolog*") - (prolog-inferior-mode) - - ;; The "INFERIOR=yes" hack is for SWI-Prolog 7.2.3 and earlier, - ;; which assumes it is running under Emacs if either INFERIOR=yes or - ;; if EMACS is set to a nonempty value. The EMACS setting is - ;; obsolescent, so set INFERIOR. Newer versions of SWI-Prolog should - ;; know about INSIDE_EMACS (which replaced EMACS) and should not need - ;; this hack. - (let ((process-environment - (if (getenv "INFERIOR") - process-environment - (cons "INFERIOR=yes" process-environment)))) - (apply 'make-comint-in-buffer "prolog" (current-buffer) - (prolog-program-name) nil (prolog-program-switches))) - - (unless prolog-system - ;; Setup auto-detection. - (setq-local - prolog-system - ;; Force re-detection. - (let* ((proc (get-buffer-process (current-buffer))) - (pmark (and proc (marker-position (process-mark proc))))) - (cond - ((null pmark) (1- (point-min))) - ;; The use of insert-before-markers in comint.el together with - ;; the potential use of comint-truncate-buffer in the output - ;; filter, means that it's difficult to reliably keep track of - ;; the buffer position where the process's output started. - ;; If possible we use a marker at "start - 1", so that - ;; insert-before-marker at `start' won't shift it. And if not, - ;; we fall back on using a plain integer. - ((> pmark (point-min)) (copy-marker (1- pmark))) - (t (1- pmark))))) - (add-hook 'comint-output-filter-functions - 'prolog-inferior-guess-flavor nil t)) - (if wait - (progn - (goto-char (point-max)) - (while - (save-excursion - (not - (re-search-backward - (concat "\\(" (prolog-prompt-regexp) "\\)" "\\=") - nil t))) - (sit-for 0.1))))))) + (let ((pname (prolog-program-name)) + (pswitches (prolog-program-switches))) + (if (null pname) + (error "This Prolog system has defined no interpreter.")) + (unless (comint-check-proc "*prolog*") + (with-current-buffer (get-buffer-create "*prolog*") + (prolog-inferior-mode) + + ;; The "INFERIOR=yes" hack is for SWI-Prolog 7.2.3 and earlier, + ;; which assumes it is running under Emacs if either INFERIOR=yes or + ;; if EMACS is set to a nonempty value. The EMACS setting is + ;; obsolescent, so set INFERIOR. Newer versions of SWI-Prolog should + ;; know about INSIDE_EMACS (which replaced EMACS) and should not need + ;; this hack. + (let ((process-environment + (if (getenv "INFERIOR") + process-environment + (cons "INFERIOR=yes" process-environment)))) + (apply 'make-comint-in-buffer "prolog" (current-buffer) + pname nil pswitches)) + + (unless prolog-system + ;; Setup auto-detection. + (setq-local + prolog-system + ;; Force re-detection. + (let* ((proc (get-buffer-process (current-buffer))) + (pmark (and proc (marker-position (process-mark proc))))) + (cond + ((null pmark) (1- (point-min))) + ;; The use of insert-before-markers in comint.el together with + ;; the potential use of comint-truncate-buffer in the output + ;; filter, means that it's difficult to reliably keep track of + ;; the buffer position where the process's output started. + ;; If possible we use a marker at "start - 1", so that + ;; insert-before-marker at `start' won't shift it. And if not, + ;; we fall back on using a plain integer. + ((> pmark (point-min)) (copy-marker (1- pmark))) + (t (1- pmark))))) + (add-hook 'comint-output-filter-functions + 'prolog-inferior-guess-flavor nil t)) + (if wait + (progn + (goto-char (point-max)) + (while + (save-excursion + (not + (re-search-backward + (concat "\\(" (prolog-prompt-regexp) "\\)" "\\=") + nil t))) + (sit-for 0.1)))))))) (defun prolog-inferior-buffer (&optional dont-run) (or (get-buffer "*prolog*") commit f472dd8ea5d94f0231bb7bf23552895c3ab19689 Author: Mattias Engdegård Date: Fri Jul 30 12:22:01 2021 +0200 Simplify lexical let-optimisations Ensure in cconv that let-bindings have the normal form (VAR EXPR) where VAR is a valid variable name, so that we don't need to keep re-checking this all the time in the optimiser. * lisp/emacs-lisp/byte-opt.el (byte-optimize-enable-variable-constprop) (byte-optimize-warn-eliminated-variable): Remove; these were mainly used for debugging. * lisp/emacs-lisp/byte-opt.el (byte-optimize-let-form): Assume normalised let-bindings (with lexical-binding). Stop using the variables removed above. * lisp/emacs-lisp/cconv.el (cconv-convert): Ensure normalised let-bindings. Malformed bindings are dropped after warning. remove byte-optimize-warn-eliminated-variable diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index d444d7006e..142f206428 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -310,14 +310,6 @@ Earlier variables shadow later ones with the same name.") ;;; implementing source-level optimizers -(defconst byte-optimize-enable-variable-constprop t - "If non-nil, enable constant propagation through local variables.") - -(defconst byte-optimize-warn-eliminated-variable nil - "Whether to warn when a variable is optimised away entirely. -This does usually not indicate a problem and makes the compiler -very chatty, but can be useful for debugging.") - (defvar byte-optimize--vars-outside-condition nil "Alist of variables lexically bound outside conditionally executed code. Variables here are sensitive to mutation inside the conditional code, @@ -691,28 +683,24 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") ;; Recursively enter the optimizer for the bindings and body ;; of a let or let*. This for depth-firstness: forms that ;; are more deeply nested are optimized first. - (if (and lexical-binding byte-optimize-enable-variable-constprop) + (if lexical-binding (let* ((byte-optimize--lexvars byte-optimize--lexvars) (new-lexvars nil) (let-vars nil)) (dolist (binding (car form)) - (let (name expr) - (if (atom binding) - (setq name binding) - (setq name (car binding)) - (setq expr (byte-optimize-form (cadr binding) nil))) - (let* ((value (and (byte-optimize--substitutable-p expr) - (list expr))) - (lexical (not (or (and (symbolp name) - (special-variable-p name)) - (memq name byte-compile-bound-variables) - (memq name byte-optimize--dynamic-vars)))) - (lexinfo (and lexical (cons name (cons nil value))))) - (push (cons name (cons expr (cdr lexinfo))) let-vars) - (when lexinfo - (push lexinfo (if (eq head 'let*) - byte-optimize--lexvars - new-lexvars)))))) + (let* ((name (car binding)) + (expr (byte-optimize-form (cadr binding) nil)) + (value (and (byte-optimize--substitutable-p expr) + (list expr))) + (lexical (not (or (special-variable-p name) + (memq name byte-compile-bound-variables) + (memq name byte-optimize--dynamic-vars)))) + (lexinfo (and lexical (cons name (cons nil value))))) + (push (cons name (cons expr (cdr lexinfo))) let-vars) + (when lexinfo + (push lexinfo (if (eq head 'let*) + byte-optimize--lexvars + new-lexvars))))) (setq byte-optimize--lexvars (append new-lexvars byte-optimize--lexvars)) ;; Walk the body expressions, which may mutate some of the records, @@ -722,10 +710,8 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (bindings nil)) (dolist (var let-vars) ;; VAR is (NAME EXPR [KEEP [VALUE]]) - (if (and (nthcdr 3 var) (not (nth 2 var))) - ;; Value present and not marked to be kept: eliminate. - (when byte-optimize-warn-eliminated-variable - (byte-compile-warn "eliminating local variable %S" (car var))) + (when (or (not (nthcdr 3 var)) (nth 2 var)) + ;; Value not present, or variable marked to be kept. (push (list (nth 0 var) (nth 1 var)) bindings))) (cons bindings opt-body))) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index e0795975c9..3abbf71687 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -357,88 +357,91 @@ places where they originally did not directly appear." "Malformed `%S' binding: %S" letsym binder)) (setq value (cadr binder)) - (car binder))) - (_ (cond - ((not (symbolp var)) - (byte-compile-warn "attempt to let-bind nonvariable `%S'" - var)) - ((or (booleanp var) (keywordp var)) - (byte-compile-warn "attempt to let-bind constant `%S'" - var)))) - (new-val - (pcase (cconv--var-classification binder form) - ;; Check if var is a candidate for lambda lifting. - ((and :lambda-candidate - (guard - (progn - (cl-assert (and (eq (car value) 'function) - (eq (car (cadr value)) 'lambda))) - (cl-assert (equal (cddr (cadr value)) - (caar cconv-freevars-alist))) - ;; Peek at the freevars to decide whether to λ-lift. - (let* ((fvs (cdr (car cconv-freevars-alist))) - (fun (cadr value)) - (funargs (cadr fun)) - (funcvars (append fvs funargs))) + (car binder)))) + (cond + ;; Ignore bindings without a valid name. + ((not (symbolp var)) + (byte-compile-warn "attempt to let-bind nonvariable `%S'" var)) + ((or (booleanp var) (keywordp var)) + (byte-compile-warn "attempt to let-bind constant `%S'" var)) + (t + (let ((new-val + (pcase (cconv--var-classification binder form) + ;; Check if var is a candidate for lambda lifting. + ((and :lambda-candidate + (guard + (progn + (cl-assert (and (eq (car value) 'function) + (eq (car (cadr value)) 'lambda))) + (cl-assert (equal (cddr (cadr value)) + (caar cconv-freevars-alist))) + ;; Peek at the freevars to decide whether + ;; to λ-lift. + (let* ((fvs (cdr (car cconv-freevars-alist))) + (fun (cadr value)) + (funargs (cadr fun)) + (funcvars (append fvs funargs))) ; lambda lifting condition - (and fvs (>= cconv-liftwhen - (length funcvars))))))) + (and fvs (>= cconv-liftwhen + (length funcvars))))))) ; Lift. - (let* ((fvs (cdr (pop cconv-freevars-alist))) - (fun (cadr value)) - (funargs (cadr fun)) - (funcvars (append fvs funargs)) - (funcbody (cddr fun)) - (funcbody-env ())) - (push `(,var . (apply-partially ,var . ,fvs)) new-env) - (dolist (fv fvs) - (cl-pushnew fv new-extend) - (if (and (eq 'car-safe (car-safe (cdr (assq fv env)))) - (not (memq fv funargs))) - (push `(,fv . (car-safe ,fv)) funcbody-env))) - `(function (lambda ,funcvars . - ,(cconv--convert-funcbody - funargs funcbody funcbody-env value))))) - - ;; Check if it needs to be turned into a "ref-cell". - (:captured+mutated - ;; Declared variable is mutated and captured. - (push `(,var . (car-safe ,var)) new-env) - `(list ,(cconv-convert value env extend))) - - ;; Check if it needs to be turned into a "ref-cell". - (:unused - ;; Declared variable is unused. - (if (assq var new-env) (push `(,var) new-env)) ;FIXME:Needed? - (let ((newval - `(ignore ,(cconv-convert value env extend))) - (msg (cconv--warn-unused-msg var "variable"))) - (if (null msg) newval - (macroexp--warn-wrap msg newval 'lexical)))) - - ;; Normal default case. - (_ - (if (assq var new-env) (push `(,var) new-env)) - (cconv-convert value env extend))))) - - (when (and (eq letsym 'let*) (memq var new-extend)) - ;; One of the lambda-lifted vars is shadowed, so add - ;; a reference to the outside binding and arrange to use - ;; that reference. - (let ((closedsym (make-symbol (format "closed-%s" var)))) - (setq new-env (cconv--remap-llv new-env var closedsym)) - (setq new-extend (cons closedsym (remq var new-extend))) - (push `(,closedsym ,var) binders-new))) - - ;; We push the element after redefined free variables are - ;; processed. This is important to avoid the bug when free - ;; variable and the function have the same name. - (push (list var new-val) binders-new) - - (when (eq letsym 'let*) - (setq env new-env) - (setq extend new-extend)) - )) ; end of dolist over binders + (let* ((fvs (cdr (pop cconv-freevars-alist))) + (fun (cadr value)) + (funargs (cadr fun)) + (funcvars (append fvs funargs)) + (funcbody (cddr fun)) + (funcbody-env ())) + (push `(,var . (apply-partially ,var . ,fvs)) new-env) + (dolist (fv fvs) + (cl-pushnew fv new-extend) + (if (and (eq 'car-safe (car-safe + (cdr (assq fv env)))) + (not (memq fv funargs))) + (push `(,fv . (car-safe ,fv)) funcbody-env))) + `(function (lambda ,funcvars . + ,(cconv--convert-funcbody + funargs funcbody funcbody-env value))))) + + ;; Check if it needs to be turned into a "ref-cell". + (:captured+mutated + ;; Declared variable is mutated and captured. + (push `(,var . (car-safe ,var)) new-env) + `(list ,(cconv-convert value env extend))) + + ;; Check if it needs to be turned into a "ref-cell". + (:unused + ;; Declared variable is unused. + (if (assq var new-env) + (push `(,var) new-env)) ;FIXME:Needed? + (let ((newval + `(ignore ,(cconv-convert value env extend))) + (msg (cconv--warn-unused-msg var "variable"))) + (if (null msg) newval + (macroexp--warn-wrap msg newval 'lexical)))) + + ;; Normal default case. + (_ + (if (assq var new-env) (push `(,var) new-env)) + (cconv-convert value env extend))))) + + (when (and (eq letsym 'let*) (memq var new-extend)) + ;; One of the lambda-lifted vars is shadowed, so add + ;; a reference to the outside binding and arrange to use + ;; that reference. + (let ((closedsym (make-symbol (format "closed-%s" var)))) + (setq new-env (cconv--remap-llv new-env var closedsym)) + (setq new-extend (cons closedsym (remq var new-extend))) + (push `(,closedsym ,var) binders-new))) + + ;; We push the element after redefined free variables are + ;; processed. This is important to avoid the bug when free + ;; variable and the function have the same name. + (push (list var new-val) binders-new) + + (when (eq letsym 'let*) + (setq env new-env) + (setq extend new-extend)))))) + ) ; end of dolist over binders (when (not (eq letsym 'let*)) ;; We can't do the cconv--remap-llv at the same place for let and commit 16876744d44b07ab9486fcea388254b9b8f617a5 Author: Lars Ingebrigtsen Date: Fri Jul 30 14:07:04 2021 +0200 Ensure that recover-file doesn't leave stale auto-save files behind * lisp/files.el (recover-file): Don't leave stale auto-save files behind after crash recovery (bug#11331). diff --git a/lisp/files.el b/lisp/files.el index 0bf866d0ec..2b13d04bcb 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6615,7 +6615,8 @@ details on the arguments, see `revert-buffer'." (coding-system-for-read 'auto-save-coding)) (erase-buffer) (insert-file-contents file-name nil) - (set-buffer-file-coding-system coding-system)) + (set-buffer-file-coding-system coding-system) + (set-buffer-auto-saved)) (after-find-file nil nil t)) (t (user-error "Recover-file canceled"))))) commit 2ece0f8d3c741bf27c6e035c5fcd2d60f164ab51 Author: Lars Ingebrigtsen Date: Fri Jul 30 14:03:43 2021 +0200 Allow shell PROMPT strings to have ANSI codes * lisp/comint.el (comint-output-filter): Don't overwrite ANSI codes from the prompt command (bug#11883). diff --git a/lisp/comint.el b/lisp/comint.el index 7801261621..40f58f2da7 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -2157,9 +2157,9 @@ Make backspaces delete the previous character." 'comint-highlight-prompt)) (setq comint-last-prompt (cons (copy-marker prompt-start) (point-marker))) - (font-lock-prepend-text-property prompt-start (point) - 'font-lock-face - 'comint-highlight-prompt) + (font-lock-append-text-property prompt-start (point) + 'font-lock-face + 'comint-highlight-prompt) (add-text-properties prompt-start (point) `(rear-nonsticky ,comint--prompt-rear-nonsticky))) commit 920aaef9d95c7b6ac3cbb31f5d2217b620872cab Author: Max Nikulin Date: Fri Jul 30 14:00:41 2021 +0200 mailcap.el: Avoid xdg-open silent failure * lisp/net/mailcap.el (mailcap-view-file): Use 'pipe :connection-type instead of 'pty to prevent killing of background process on handler exit. Avoid regression similar to Bug#44824. Problem happens only in some desktop environments where mailcap handler launches actual viewer (as defined in .desktop files and obtained from mimeapps.list) in background. E.g. xdg-open invokes "gio open" or kde-open5 for Gnome or KDE accordingly and these handlers launch e.g. eog or okular in background. As soon as main process exits, temporary terminal session created by `start-process-shell-command' is terminated. As a result background processes receive SIGHUP. Previously command were executed with no buffer as well, so the change does not affect "needsterminal" and "copiousoutput" mailcap features, they are not supported as earlier. If main process of the handler fails then show a message with exit reason. Output (including error messages) is ignored as before. Gtk applications tend to report significant amount of failed asserts hardly informative for majority of users (bug#12972). Copyright-paperwork-exempt: yes diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 54f7f416ab..f64897ac9b 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -1177,7 +1177,25 @@ See \"~/.mailcap\", `mailcap-mime-data' and related files and variables." (shell-quote-argument (convert-standard-filename file)) command nil t)) - (start-process-shell-command command nil command))) + ;; Handlers such as "gio open" and kde-open5 start viewer in background + ;; and exit immediately. Avoid `start-process' since it assumes + ;; :connection-type `pty' and kills children processes with SIGHUP + ;; when temporary terminal session is finished (Bug#44824). + ;; An alternative is `process-connection-type' let-bound to nil for + ;; `start-process-shell-command' call (with no chance to report failure). + (make-process + :name "mailcap-view-file" + :connection-type 'pipe + :noquery t + :buffer nil ; "*Messages*" may be suitable for debugging + :sentinel (lambda (proc event) + (when (and (memq (process-status proc) '(exit signal)) + (/= (process-exit-status proc) 0)) + (message + "Command %s: %s." + (mapconcat #'identity (process-command proc) " ") + (substring event 0 -1)))) + :command (list shell-file-name shell-command-switch command)))) (provide 'mailcap) commit 88ba1a86c2db950a8905d3e2a6215f2225e9b3a6 Author: Lars Ingebrigtsen Date: Fri Jul 30 13:51:46 2021 +0200 Fix case insensitivity in `read-file-name' * lisp/minibuffer.el (read-file-name-default): Make `read-file-name' actually respect `read-file-name-completion-ignore-case' (bug#14340). diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 1578ab8e1e..3751ba80e0 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3087,7 +3087,7 @@ See `read-file-name' for the meaning of the arguments." (minibuffer-maybe-quote-filename dir))) (initial (cons (minibuffer-maybe-quote-filename initial) 0))))) - (let ((completion-ignore-case read-file-name-completion-ignore-case) + (let ((ignore-case read-file-name-completion-ignore-case) (minibuffer-completing-file-name t) (pred (or predicate 'file-exists-p)) (add-to-history nil)) @@ -3115,6 +3115,7 @@ See `read-file-name' for the meaning of the arguments." minibuffer-default)) (setq minibuffer-default (cdr-safe minibuffer-default))) + (setq-local completion-ignore-case ignore-case) ;; On the first request on `M-n' fill ;; `minibuffer-default' with a list of defaults ;; relevant for file-name reading. commit 0bd1346318fe9ef4eba91905172d30a030d7da18 Author: Lars Ingebrigtsen Date: Fri Jul 30 13:32:54 2021 +0200 Fix issue with mml-preview from outside Gnus * lisp/gnus/gnus-art.el (gnus-mime-display-alternative): Be more resilient when running from outside Gnus. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index b989446792..fb0295d070 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -6238,8 +6238,9 @@ If nil, don't show those extra buttons." (gnus-display-mime preferred) (let ((mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (with-current-buffer gnus-summary-buffer - gnus-newsgroup-ignored-charsets))) + (and (buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets)))) (gnus-bind-mm-vars (mm-display-part preferred)) ;; Do highlighting. (save-excursion commit 4053bd5201252850aa816150925aa256e5ab7238 Author: Lars Ingebrigtsen Date: Fri Jul 30 13:13:46 2021 +0200 Work around long-standing seq.el compilation warning * lisp/emacs-lisp/seq.el (seq-contains): When using cl-defgeneric to define an obsolete function, it'll complain about it being obsolete. Suppress that warning. (Should probably be fixed in cl-defgeneric instead.) diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 6c15463ad5..e8fc4a2814 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -394,14 +394,15 @@ found or not." (setq count (+ 1 count)))) count)) -(cl-defgeneric seq-contains (sequence elt &optional testfn) - "Return the first element in SEQUENCE that is equal to ELT. +(with-suppressed-warnings ((obsolete seq-contains)) + (cl-defgeneric seq-contains (sequence elt &optional testfn) + "Return the first element in SEQUENCE that is equal to ELT. Equality is defined by TESTFN if non-nil or by `equal' if nil." - (declare (obsolete seq-contains-p "27.1")) - (seq-some (lambda (e) - (when (funcall (or testfn #'equal) elt e) - e)) - sequence)) + (declare (obsolete seq-contains-p "27.1")) + (seq-some (lambda (e) + (when (funcall (or testfn #'equal) elt e) + e)) + sequence))) (cl-defgeneric seq-contains-p (sequence elt &optional testfn) "Return non-nil if SEQUENCE contains an element equal to ELT. commit 97894b07c2a6dea48f048e0d0c19d5717912cdf6 Author: Basil L. Contovounesios Date: Fri Jul 30 11:30:53 2021 +0100 Remove a redundant let-binding from Ispell Recent optimizer changes revealed a case-fold-search binding in Ispell that was made redundant in the revision of 2020-11-03 "Simplify ispell-check-version’s use of -vv flag". * lisp/textmodes/ispell.el (ispell-check-version): Remove no-op binding of case-fold-search. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 0a82bf5a2d..4c64531ea3 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -649,11 +649,7 @@ Otherwise returns the library directory name, if that is defined." result libvar status ispell-program-version) (with-temp-buffer - (setq status (ispell-call-process - ispell-program-name nil t nil - (let ((case-fold-search - (memq system-type '(ms-dos windows-nt)))) - "-vv"))) + (setq status (ispell-call-process ispell-program-name nil t nil "-vv")) (goto-char (point-min)) (if interactivep ;; Report version information of ispell commit 5f65b67daccf7f4f30274f147a1adb5142328c6d Author: Michael Albinus Date: Fri Jul 30 11:57:50 2021 +0200 * etc/NEWS: Tramp supports authentication via yubikey now. Fix typos. diff --git a/etc/NEWS b/etc/NEWS index 5f9be88297..d378a81890 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -769,7 +769,7 @@ compilation buffers, recenters the current displayed occurrence/error. --- *** Occur mode may use a different type for 'occur-target' property values. The value was previously always a marker set to the start of the first -match on the line but can now also be a list of (BEGIN . END) pairs +match on the line but can now also be a list of '(BEGIN . END)' pairs of markers delimiting each match on the line. This is a fully compatible change to the internal occur-mode implementation, and code creating their own occur-mode buffers will @@ -904,7 +904,7 @@ keys, add the following to your init file: ** Change Logs and VC -*** vc-git now sets the GIT_LITERAL_PATHSPECS environment variable. +*** vc-git now sets the 'GIT_LITERAL_PATHSPECS' environment variable. This ensures that Git operations on files containing wildcard characters work as they're supposed to. However, this also affects scripts running from Git hooks, and these have to "unset @@ -1506,6 +1506,9 @@ like cell phones, tablets or cameras. *** New connection method "sshfs", which allows accessing remote files via a file system mounted with 'sshfs'. +--- +*** Tramp supports authentication via yubikey now. + +++ *** Trashed remote files are moved to the local trash directory. All remote files, which are trashed, are moved to the local trash @@ -1750,7 +1753,7 @@ Function 'mh-junk-whitelist' is renamed 'mh-junk-allowlist'. Function 'mh-junk-blacklist' is renamed 'mh-junk-blocklist'. +++ -*** New binding for mh-junk-allowlist. +*** New binding for 'mh-junk-allowlist'. The key binding for 'mh-junk-allowlist' is changed from 'J w' to 'J a'. The old binding is supported but warns that it is obsolete. @@ -2097,7 +2100,7 @@ support, and it is available on the current system. +++ *** Native JSON functions now signal an error if libjansson is unavailable. -This affects 'json-serialize', 'json-insert', 'json-parse-srtring', +This affects 'json-serialize', 'json-insert', 'json-parse-string', and 'json-parse-buffer'. This can happen if Emacs was compiled with libjansson, but the DLL cannot be found and/or loaded by Emacs at run time. Previously, Emacs would display a message and return nil in @@ -2338,9 +2341,9 @@ This command, called interactively, toggles the local value of ** Miscellaneous +++ -*** .dir-locals.el now supports setting 'auto-mode-alist'. -The new 'auto-mode-alist' specification in .dir-local.el files can now -be used to override the global 'auto-mode-alist' in the current +*** ".dir-locals.el" now supports setting 'auto-mode-alist'. +The new 'auto-mode-alist' specification in ".dir-locals.el" files can +now be used to override the global 'auto-mode-alist' in the current directory tree. --- @@ -2365,7 +2368,7 @@ local-variables section of a file. --- *** 'tabulated-list-mode' can now restore original display order. Many commands (like 'C-x C-b') are derived from 'tabulated-list-mode', -and that mode allow the user to sort on any column. There was +and that mode allows the user to sort on any column. There was previously no easy way to get back to the original displayed order after sorting, but giving a -1 numerical prefix to the sorting command will now restore the original order. @@ -2911,7 +2914,7 @@ This is to keep the same behavior as Eshell. --- ** 'kill-all-local-variables' has changed how it handles non-symbol hooks. -The function is documented to eliminated all buffer-local bindings +The function is documented to eliminate all buffer-local bindings except variables with a 'permanent-local' property, or hooks that have elements with a 'permanent-local-hook' property. In addition, it would also keep lambda expressions in hooks sometimes. The latter has commit 245d3e9ffded314a25449f69f844eaf80a89c340 Author: Michael Albinus Date: Fri Jul 30 11:57:39 2021 +0200 Fix bug#49773 in Tramp * lisp/net/tramp.el (tramp-handle-find-backup-file-name) (tramp-handle-lock-file, tramp-handle-make-auto-save-file-name): Check security hole only if action is in progress. (Bug#49773) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 80cdd56c0d..959a0e7435 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3665,6 +3665,7 @@ User is always nil." #'find-backup-file-name (list filename))) ;; Protect against security hole. (when (and (not tramp-allow-unsafe-temporary-files) + (not backup-inhibited) (file-in-directory-p (car result) temporary-file-directory) (zerop (or (tramp-compat-file-attribute-user-id (file-attributes filename 'integer)) @@ -3885,6 +3886,7 @@ Return nil when there is no lockfile." ;; Protect against security hole. (with-parsed-tramp-file-name file nil (when (and (not tramp-allow-unsafe-temporary-files) + create-lockfiles (file-in-directory-p lockname temporary-file-directory) (zerop (or (tramp-compat-file-attribute-user-id (file-attributes file 'integer)) @@ -5425,6 +5427,7 @@ this file, if that variable is non-nil." (setq result (tramp-run-real-handler #'make-auto-save-file-name nil)) ;; Protect against security hole. (when (and (not tramp-allow-unsafe-temporary-files) + auto-save-default (file-in-directory-p result temporary-file-directory) (zerop (or (tramp-compat-file-attribute-user-id (file-attributes filename 'integer)) commit 52a55e11deb7822c67a8d7e6f2544b8f41d25a4e Author: Mattias Engdegård Date: Thu Jul 29 15:35:55 2021 +0200 Optimise let and let* whose body is constant or the last variable Simplify (let ((X1 E1) ... (Xn En)) Xn) => (progn E1 ... En) and (let* ((X1 E1) ... (Xn En)) Xn) => (let* ((X1 E1) ... (Xn-1 En-1)) En) and similarly the case where the body is a constant, extending a previous optimisation that only applied to the constant nil. This reduces the number of bound variables, shortens the code, and enables further optimisations. * lisp/emacs-lisp/byte-opt.el (byte-optimize-letX): Rewrite using `pcase` and add the aforementioned transformations. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases): Add test cases. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index c9dfa69aeb..d444d7006e 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1250,18 +1250,31 @@ See Info node `(elisp) Integer Basics'." (put 'let 'byte-optimizer #'byte-optimize-letX) (put 'let* 'byte-optimizer #'byte-optimize-letX) (defun byte-optimize-letX (form) - (cond ((null (nth 1 form)) - ;; No bindings - (cons 'progn (cdr (cdr form)))) - ((or (nth 2 form) (nthcdr 3 form)) - form) - ;; The body is nil - ((eq (car form) 'let) - (append '(progn) (mapcar 'car-safe (mapcar 'cdr-safe (nth 1 form))) - '(nil))) - (t - (let ((binds (reverse (nth 1 form)))) - (list 'let* (reverse (cdr binds)) (nth 1 (car binds)) nil))))) + (pcase form + ;; No bindings. + (`(,_ () . ,body) + `(progn . ,body)) + + ;; Body is empty or just contains a constant. + (`(,head ,bindings . ,(or '() `(,(and const (pred macroexp-const-p))))) + (if (eq head 'let) + `(progn ,@(mapcar (lambda (binding) + (and (consp binding) (cadr binding))) + bindings) + ,const) + `(let* ,(butlast bindings) ,(cadar (last bindings)) ,const))) + + ;; Body is last variable. + (`(,head ,bindings ,(and var (pred symbolp) (pred (not keywordp)) + (pred (not booleanp)) + (guard (eq var (caar (last bindings)))))) + (if (eq head 'let) + `(progn ,@(mapcar (lambda (binding) + (and (consp binding) (cadr binding))) + bindings)) + `(let* ,(butlast bindings) ,(cadar (last bindings))))) + + (_ form))) (put 'nth 'byte-optimizer #'byte-optimize-nth) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index ee0f931c19..5aa853c721 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -509,6 +509,24 @@ ((member x '("b" "c")) 2) ((not x) 3))) '("a" "b" "c" "d" nil)) + + ;; `let' and `let*' optimisations with body being constant or variable + (let* (a + (b (progn (setq a (cons 1 a)) 2)) + (c (1+ b)) + (d (list a c))) + d) + (let ((a nil)) + (let ((b (progn (setq a (cons 1 a)) 2)) + (c (progn (setq a (cons 3 a)))) + (d (list a))) + d)) + (let* ((_a 1) + (_b 2)) + 'z) + (let ((_a 1) + (_b 2)) + 'z) ) "List of expressions for cross-testing interpreted and compiled code.") commit ab9c06449df4c4c58d586573003de419199cc1be Author: Mattias Engdegård Date: Thu Jul 29 17:20:41 2021 +0200 Move warnings about bad let-bindings from source optimiser to cconv * lisp/emacs-lisp/byte-opt.el (byte-optimize-let-form): Move warnings... * lisp/emacs-lisp/cconv.el (cconv-convert): ...here, which is an overall better place (closer to the front-end). diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index b6052d8206..c9dfa69aeb 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -697,16 +697,11 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (let-vars nil)) (dolist (binding (car form)) (let (name expr) - (cond ((consp binding) - (setq name (car binding)) - (unless (symbolp name) - (byte-compile-warn "let-bind nonvariable: `%S'" name)) - (setq expr (byte-optimize-form (cadr binding) nil))) - ((symbolp binding) - (setq name binding)) - (t (byte-compile-warn "malformed let binding: `%S'" binding))) - (let* ( - (value (and (byte-optimize--substitutable-p expr) + (if (atom binding) + (setq name binding) + (setq name (car binding)) + (setq expr (byte-optimize-form (cadr binding) nil))) + (let* ((value (and (byte-optimize--substitutable-p expr) (list expr))) (lexical (not (or (and (symbolp name) (special-variable-p name)) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index ea0b09805e..e0795975c9 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -358,6 +358,13 @@ places where they originally did not directly appear." letsym binder)) (setq value (cadr binder)) (car binder))) + (_ (cond + ((not (symbolp var)) + (byte-compile-warn "attempt to let-bind nonvariable `%S'" + var)) + ((or (booleanp var) (keywordp var)) + (byte-compile-warn "attempt to let-bind constant `%S'" + var)))) (new-val (pcase (cconv--var-classification binder form) ;; Check if var is a candidate for lambda lifting. commit dc9e2a1749c892cdf52a01414bee97e9a2245ca5 Author: Mattias Engdegård Date: Thu Jul 29 10:07:26 2021 +0200 Optimise prog1 better Rewrite (prog1 CONST FORMS...) => (progn FORMS... CONST) where CONST is a compile-time constant, because putting the value last allows the lapcode peephole pass to do important improvements like branch elimination. Also use progn instead of prog1 for `ignore`. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): New `prog1` and `ignore` transforms. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 58a08eb3cd..b6052d8206 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -452,10 +452,13 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (macroexp-progn (byte-optimize-body exps for-effect)) (byte-optimize-form (car exps) for-effect))) (`(prog1 ,exp . ,exps) - (if exps - `(prog1 ,(byte-optimize-form exp for-effect) - . ,(byte-optimize-body exps t)) - (byte-optimize-form exp for-effect))) + (let ((exp-opt (byte-optimize-form exp for-effect))) + (if exps + (let ((exps-opt (byte-optimize-body exps t))) + (if (macroexp-const-p exp-opt) + `(progn ,@exps-opt ,exp-opt) + `(prog1 ,exp-opt ,@exps-opt))) + exp-opt))) (`(,(or `save-excursion `save-restriction `save-current-buffer) . ,exps) ;; Those subrs which have an implicit progn; it's not quite good @@ -572,7 +575,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") ;; computed for effect. We want to avoid the warnings ;; that might occur if they were treated that way. ;; However, don't actually bother calling `ignore'. - `(prog1 nil . ,(mapcar #'byte-optimize-form exps))) + `(progn ,@(mapcar #'byte-optimize-form exps) nil)) ;; Needed as long as we run byte-optimize-form after cconv. (`(internal-make-closure . ,_) commit 9a6333811441a32e49bfd33c14f77680402cd639 Author: Mattias Engdegård Date: Wed Jul 28 17:31:44 2021 +0200 Elide lexical variables in for-effect context in source optimiser * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Remove for-effect uses of lexical variables. We previously relied on this being done by the lapcode peephole optimiser but at source level it enables more optimisation opportunities. Keywords are elided for the same reason. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 4117533cda..58a08eb3cd 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -402,19 +402,24 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") ((and for-effect (or byte-compile-delete-errors (not (symbolp form)) - (eq form t))) + (eq form t) + (keywordp form))) nil) ((symbolp form) (let ((lexvar (assq form byte-optimize--lexvars))) - (if (cddr lexvar) ; Value available? - (if (assq form byte-optimize--vars-outside-loop) - ;; Cannot substitute; mark for retention to avoid the - ;; variable being eliminated. - (progn - (setcar (cdr lexvar) t) - form) - (caddr lexvar)) ; variable value to use - form))) + (cond + ((not lexvar) form) + (for-effect nil) + ((cddr lexvar) ; Value available? + (if (assq form byte-optimize--vars-outside-loop) + ;; Cannot substitute; mark for retention to avoid the + ;; variable being eliminated. + (progn + (setcar (cdr lexvar) t) + form) + ;; variable value to use + (caddr lexvar))) + (t form)))) (t form))) (`(quote . ,v) (if (or (not v) (cdr v)) commit 566e29f78ccee4fcf0421576c0306860c8afae0f Author: Mattias Engdegård Date: Wed Jul 28 21:12:27 2021 +0200 Single source optimiser entry point Make the optimiser aware of lexical arguments. Otherwise we cannot know for sure whether a variable is lexical or dynamic during traversal. * lisp/emacs-lisp/byte-opt.el (byte-optimize-one-form): New optimiser entry point, replacing the recursive byte-optimize-form. * lisp/emacs-lisp/bytecomp.el (byte-optimize-one-form): Autoload. (byte-compile-keep-pending, byte-compile-top-level): Use byte-optimize-one-form. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index ad9f827171..4117533cda 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -652,8 +652,15 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (byte-optimize-constant-args form) form)))))) -(defun byte-optimize-form (form &optional for-effect) +(defun byte-optimize-one-form (form &optional for-effect) "The source-level pass of the optimizer." + ;; Make optimiser aware of lexical arguments. + (let ((byte-optimize--lexvars + (mapcar (lambda (v) (list (car v) t)) + byte-compile--lexical-environment))) + (byte-optimize-form form for-effect))) + +(defun byte-optimize-form (form &optional for-effect) (while (progn ;; First, optimize all sub-forms of this one. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index a6e7e03cb0..7bd642d2b2 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -192,7 +192,7 @@ otherwise adds \".elc\"." (autoload 'byte-compile-inline-expand "byte-opt") ;; This is the entry point to the lapcode optimizer pass1. -(autoload 'byte-optimize-form "byte-opt") +(autoload 'byte-optimize-one-form "byte-opt") ;; This is the entry point to the lapcode optimizer pass2. (autoload 'byte-optimize-lapcode "byte-opt") @@ -2455,7 +2455,7 @@ list that represents a doc string reference. (defun byte-compile-keep-pending (form &optional handler) (if (memq byte-optimize '(t source)) - (setq form (byte-optimize-form form t))) + (setq form (byte-optimize-one-form form t))) (if handler (let ((byte-compile--for-effect t)) ;; To avoid consing up monstrously large forms at load time, we split @@ -3155,7 +3155,7 @@ for symbols generated by the byte compiler itself." (byte-compile-output nil) (byte-compile-jump-tables nil)) (if (memq byte-optimize '(t source)) - (setq form (byte-optimize-form form byte-compile--for-effect))) + (setq form (byte-optimize-one-form form byte-compile--for-effect))) (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form)))) (setq form (nth 1 form))) ;; Set up things for a lexically-bound function.