From 45089f9588e1fccda16fd4a69a618695453c8d88 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 19 Jan 2026 12:02:12 +0100 Subject: [PATCH] * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Speed up. Manicure pcase patterns to avoid performance-sapping internal functions and switch-breaking gaps, resulting in smaller code and less allocation. --- lisp/emacs-lisp/macroexp.el | 181 ++++++++++++++++++++---------------- 1 file changed, 99 insertions(+), 82 deletions(-) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index dcb519b33b5..d9ca6f0b19a 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -469,16 +469,23 @@ Assumes the caller has bound `macroexpand-all-environment'." (macroexp-warn-and-return (format-message "`condition-case' without handlers") exp-body (list 'suspicious 'condition-case) t form)))) - (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_) - (push name macroexp--dynvars) - (macroexp--all-forms form 2)) - (`(function ,(and f `(lambda . ,_))) - (let ((macroexp--dynvars macroexp--dynvars)) - (macroexp--cons fn - (macroexp--cons (macroexp--all-forms f 2) - nil - (cdr form)) - form))) + (`(,(or 'defvar 'defconst) . ,args) + (if (and (car-safe args) (symbolp (car-safe args))) + (progn + (push (car args) macroexp--dynvars) + (macroexp--all-forms form 2)) + form)) + (`(function . ,rest) + (if (and (eq (car-safe (car-safe rest)) 'lambda) + (null (cdr rest))) + (let ((f (car rest))) + (let ((macroexp--dynvars macroexp--dynvars)) + (macroexp--cons fn + (macroexp--cons (macroexp--all-forms f 2) + nil + (cdr form)) + form))) + form)) (`(,(or 'function 'quote) . ,_) form) (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) pcase--dontcare)) @@ -495,82 +502,88 @@ Assumes the caller has bound `macroexpand-all-environment'." (macroexp--all-forms body)) (cdr form)) form))) - (`(while) - (macroexp-warn-and-return - (format-message "missing `while' condition") - `(signal 'wrong-number-of-arguments '(while 0)) - nil 'compile-only form)) - (`(unwind-protect ,expr) - (macroexp-warn-and-return - (format-message "`unwind-protect' without unwind forms") - (macroexp--expand-all expr) - (list 'suspicious 'unwind-protect) t form)) - (`(setq ,(and var (pred symbolp) - (pred (not booleanp)) (pred (not keywordp))) - ,expr) - ;; Fast path for the setq common case. - (let ((new-expr (macroexp--expand-all expr))) - (if (eq new-expr expr) - form - `(,fn ,var ,new-expr)))) + (`(while . ,args) + (if args + (macroexp--all-forms form 1) + (macroexp-warn-and-return + (format-message "missing `while' condition") + `(signal 'wrong-number-of-arguments '(while 0)) + nil 'compile-only form))) + (`(unwind-protect . ,args) + (if (cdr-safe args) + (macroexp--all-forms form 1) + (macroexp-warn-and-return + (format-message "`unwind-protect' without unwind forms") + (macroexp--expand-all (car-safe args)) + (list 'suspicious 'unwind-protect) t form))) (`(setq . ,args) - ;; Normalize to a sequence of (setq SYM EXPR). - ;; Malformed code is translated to code that signals an error - ;; at run time. - (let ((nargs (length args))) - (if (oddp nargs) - (macroexp-warn-and-return - (format-message "odd number of arguments in `setq' form") - `(signal 'wrong-number-of-arguments '(setq ,nargs)) - nil 'compile-only fn) - (let ((assignments nil)) - (while (consp (cdr-safe args)) - (let* ((var (car args)) - (expr (cadr args)) - (new-expr (macroexp--expand-all expr)) - (assignment - (if (and (symbolp var) - (not (booleanp var)) (not (keywordp var))) - `(,fn ,var ,new-expr) - (macroexp-warn-and-return - (format-message "attempt to set %s `%s'" - (if (symbolp var) - "constant" - "non-variable") - var) - (cond - ((keywordp var) - ;; Accept `(setq :a :a)' for compatibility. - `(if (eq ,var ,new-expr) - ,var - (signal 'setting-constant (list ',var)))) - ((symbolp var) - `(signal 'setting-constant (list ',var))) - (t - `(signal 'wrong-type-argument - (list 'symbolp ',var)))) - nil 'compile-only var)))) - (push assignment assignments)) - (setq args (cddr args))) - (cons 'progn (nreverse assignments)))))) - (`(,(and fun `(lambda . ,_)) . ,args) - (macroexp--cons (macroexp--all-forms fun 2) - (macroexp--all-forms args) - form)) + (let ((nargs (length args)) + (var (car-safe args))) + (if (and (= nargs 2) + (symbolp var) + (not (booleanp var)) (not (keywordp var))) + ;; Fast path for the common case. + (let* ((expr (nth 1 args)) + (new-expr (macroexp--expand-all expr))) + (if (eq new-expr expr) + form + `(,fn ,var ,new-expr))) + ;; Normalize to a sequence of (setq SYM EXPR). + ;; Malformed code is translated to code that signals an error + ;; at run time. + (if (oddp nargs) + (macroexp-warn-and-return + (format-message "odd number of arguments in `setq' form") + `(signal 'wrong-number-of-arguments '(setq ,nargs)) + nil 'compile-only fn) + (let ((assignments nil)) + (while (consp (cdr-safe args)) + (let* ((var (car args)) + (expr (cadr args)) + (new-expr (macroexp--expand-all expr)) + (assignment + (if (and (symbolp var) + (not (booleanp var)) + (not (keywordp var))) + `(,fn ,var ,new-expr) + (macroexp-warn-and-return + (format-message "attempt to set %s `%s'" + (if (symbolp var) + "constant" + "non-variable") + var) + (cond + ((keywordp var) + ;; Accept `(setq :a :a)' for compatibility. + ;; FIXME: Why, exactly? It's useless. + `(if (eq ,var ,new-expr) + ,var + (signal 'setting-constant (list ',var)))) + ((symbolp var) + `(signal 'setting-constant (list ',var))) + (t + `(signal 'wrong-type-argument + (list 'symbolp ',var)))) + nil 'compile-only var)))) + (push assignment assignments)) + (setq args (cddr args))) + (cons 'progn (nreverse assignments))))))) (`(funcall ,exp . ,args) (let ((eexp (macroexp--expand-all exp)) (eargs (macroexp--all-forms args))) - (pcase eexp - ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo' - ;; has a compiler-macro, or to unfold it. - ((and `#',f - (guard (and (symbolp f) - ;; bug#46636 - (not (or (special-form-p f) (macrop f)))))) - (macroexp--expand-all `(,f . ,eargs))) - (`#'(lambda . ,_) - (macroexp--unfold-lambda `(,fn ,eexp . ,eargs))) - (_ `(,fn ,eexp . ,eargs))))) + (if (eq (car-safe eexp) 'function) + (let ((f (cadr eexp))) + (cond + ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo' + ;; has a compiler-macro, or to unfold it. + ((and (symbolp f) + ;; bug#46636 + (not (or (special-form-p f) (macrop f)))) + (macroexp--expand-all `(,f . ,eargs))) + ((eq (car-safe f) 'lambda) + (macroexp--unfold-lambda `(,fn ,eexp . ,eargs))) + (t `(,fn ,eexp . ,eargs)))) + `(,fn ,eexp . ,eargs)))) (`(funcall . ,_) form) ;bug#53227 (`(,(and func (pred symbolp)) . ,_) (let ((handler (function-get func 'compiler-macro))) @@ -597,6 +610,10 @@ Assumes the caller has bound `macroexpand-all-environment'." newform (macroexp--expand-all form))) (macroexp--expand-all newform)))))) + (`(,(and fun `(lambda . ,_)) . ,args) + (macroexp--cons (macroexp--all-forms fun 2) + (macroexp--all-forms args) + form)) (_ form)))))) ;;;###autoload