diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 652c79e9c93..bc3677529e5 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -510,7 +510,12 @@ There can be multiple entries for the same NAME if it has several aliases.") (while (progn ;; First, optimize all sub-forms of this one. - (setq form (byte-optimize-form-code-walker form for-effect)) + ;; `byte-optimize-form-code-walker' fails to preserve any + ;; position on `form' in enough separate places that we invoke + ;; `macroexp-preserve-posification' here for source code economy. + (setq form + (macroexp-preserve-posification + form (byte-optimize-form-code-walker form for-effect))) ;; If a form-specific optimizer is available, run it and start over ;; until a fixpoint has been reached. @@ -519,7 +524,8 @@ There can be multiple entries for the same NAME if it has several aliases.") (let ((opt (byte-opt--fget (car form) 'byte-optimizer))) (and opt (let ((old form) - (new (funcall opt form))) + (new (macroexp-preserve-posification + form (funcall opt form)))) (byte-compile-log " %s\t==>\t%s" old new) (setq form new) (not (eq new old)))))))) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 533b3a3a1b8..1ded58b02f1 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -122,7 +122,9 @@ case return FORM unchanged." (if macroexp-inhibit-compiler-macros form (condition-case-unless-debug err - (apply handler form (cdr form)) + (macroexp-preserve-posification + form + (apply handler form (cdr form))) (error (message "Warning: Optimization failure for %S: Handler: %S\n%S" (car form) handler err) @@ -238,22 +240,101 @@ It should normally be a symbol with position and it defaults to FORM." form)))))))) (t form))) +(defun macroexp--posify-form-1 (form call-pos depth) + "The recursive part of `macroexp--posify-form'. +It modifies a single symbol to a symbol with position, or does nothing. +FORM and CALL-POS are as in that function. DEPTH is a small integer, +decremented at each recursive call, to prevent infinite recursion. + +Return the form with a symbol with position in the canonical position +for that form, either the one that was already there or CALL-POS; return +nil if this isn't possible. +" + (let (new-form) + (cond + ((zerop depth) nil) + ((and (consp form) + (symbolp (car form)) + (car form)) + (unless (symbol-with-pos-p (car form)) + (setcar form (position-symbol (car form) call-pos))) + form) + ((consp form) + (or (when (setq new-form (macroexp--posify-form-1 + (car form) call-pos (1- depth))) + (setcar form new-form) + form) + (when (setq new-form (macroexp--posify-form-1 + (cdr form) call-pos (1- depth))) + (setcdr form new-form) + form))) + ((symbolp form) + (if form ; Don't position nil! + (if (symbol-with-pos-p form) + form + (position-symbol form call-pos)))) + ((and (or (vectorp form) (recordp form))) + (let ((len (length form)) + (i 0) + ) + (while (and (< i len) + (not (setq new-form (macroexp--posify-form-1 + (aref form i) call-pos (1- depth))))) + (setq i (1+ i))) + (when (< i len) + (aset form i new-form) + form)))))) + +(defun macroexp--posify-form (form call-pos) + "Try to apply the position CALL-POS to the form FORM, if needed. +CALL-POS is a buffer position, a number. FORM may be any lisp form, +and is typically the output form returned by a macro expansion. + +Apply CALL-POS to FORM as a symbol with position, such that +`byte-compile--first-symbol-with-pos' can later return it. If there is +already a symbol with position in a \"canonical\" position for that +function, leave it unchanged and do nothing. Return the possibly +modified FORM." + (let ((new-form (macroexp--posify-form-1 form call-pos 10))) + (or new-form form))) + +(defmacro macroexp-preserve-posification (pos-form &rest body) + "Evaluate BODY..., posifying the result with POS-FORM's position, if any. +If the result of body happens to have a position already, we do not +change this." + (declare (debug (sexp body)) (indent 1)) + `(let ((call-pos (cond + ((consp ,pos-form) + (and (symbol-with-pos-p (car ,pos-form)) + (symbol-with-pos-pos (car ,pos-form)))) + ((symbol-with-pos-p ,pos-form) + (symbol-with-pos-pos ,pos-form)))) + (new-value (progn ,@body))) + (if (and call-pos + (not (or (and (consp new-value) + (symbol-with-pos-p (car new-value))) + (and (symbol-with-pos-p new-value))))) + (macroexp--posify-form new-value call-pos) + new-value))) + (defun macroexp-macroexpand (form env) "Like `macroexpand' but checking obsolescence." (let* ((macroexpand-all-environment env) new-form) - (while (not (eq form (setq new-form (macroexpand-1 form env)))) - (let ((fun (car-safe form))) - (setq form - (if (and fun (symbolp fun) - (get fun 'byte-obsolete-info)) - (macroexp-warn-and-return - (macroexp--obsolete-warning - fun (get fun 'byte-obsolete-info) - (if (symbolp (symbol-function fun)) "alias" "macro")) - new-form (list 'obsolete fun) nil fun) - new-form)))) - form)) + (macroexp-preserve-posification + form + (while (not (eq form (setq new-form (macroexpand-1 form env)))) + (let ((fun (car-safe form))) + (setq form + (if (and fun (symbolp fun) + (get fun 'byte-obsolete-info)) + (macroexp-warn-and-return + (macroexp--obsolete-warning + fun (get fun 'byte-obsolete-info) + (if (symbolp (symbol-function fun)) "alias" "macro")) + new-form (list 'obsolete fun) nil fun) + new-form)))) + form))) (defun macroexp--unfold-lambda (form &optional name) (or name (setq name "anonymous lambda")) @@ -329,6 +410,9 @@ Only valid during macro-expansion." "Expand all macros in FORM. This is an internal version of `macroexpand-all'. Assumes the caller has bound `macroexpand-all-environment'." + ;; Note that this function must preserve any position on FORM in the + ;; function's return value. See the page "Symbols with Position" in + ;; the elisp manual. (macroexp--with-extended-form-stack form (if (eq (car-safe form) 'backquote-list*) ;; Special-case `backquote-list*', as it is normally a macro that diff --git a/test/lisp/emacs-lisp/bytecomp-resources/macro-warning-position-2.el b/test/lisp/emacs-lisp/bytecomp-resources/macro-warning-position-2.el new file mode 100644 index 00000000000..7868e6e47e3 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/macro-warning-position-2.el @@ -0,0 +1,19 @@ +;; -*- lexical-binding:t -*- +(eval-and-compile + (defmacro increase () + `(let ((foo ,(point-max))) + (cond + ((consp foo) + (message "consp %s" foo) + foo) + ((numberp foo) + (1+ fooo)) ; Note the misspelling. + (t (message "Something else: %s" foo)))))) + +(defun call-increase (bar) + (cond + ((not (or (consp bar) + (numberp bar))) + bar) + (t (increase)))) + diff --git a/test/lisp/emacs-lisp/bytecomp-resources/macro-warning-position.el b/test/lisp/emacs-lisp/bytecomp-resources/macro-warning-position.el new file mode 100644 index 00000000000..d35fadac56b --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/macro-warning-position.el @@ -0,0 +1,19 @@ +;; -*- lexical-binding:t -*- +(eval-and-compile + (defmacro increase () + `(let ((foo (point-max))) + (cond + ((consp foo) + (message "consp %s" foo) + foo) + ((numberp foo) + (1+ fooo)) ; Note the misspelling. + (t (message "Something else: %s" foo)))))) + +(defun call-increase (bar) + (cond + ((not (or (consp bar) + (numberp bar))) + bar) + (t (increase)))) + diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 7382928da15..5d95e9b0ee7 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1285,6 +1285,11 @@ byte-compiled. Run with dynamic binding." "warn-make-process-missing-keyword-value.el" "missing value for keyword argument :command") +;;;; NEW STOUGH, 2025-07-13 +(bytecomp--define-warning-file-test "macro-warning-position.el" ":18:8:") + +(bytecomp--define-warning-file-test "macro-warning-position-2.el" ":18:8:") +;;;; END OF NEW STOUGH ;;;; Macro expansion.