andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Preserve source position of macro calls in macro expansions

Browse source 
This allows the byte compiler to give correct positions, those
of the invoking forms, when an error or warning is caused by
the innards of the invoked macros.

This fixes bug#73725 and bug#73746.

* lisp/emacs-lisp/macroexp.el (macroexp--posify-form-1)
(macroexp--posify-form): New functions.
(macroexp-preserve-posification): New macro.
(macroexp--compiler-macro, macroexp-macroexpand): Use the new
macro to preserve a calling form's position.

* lisp/emacs-lisp/byte-opt.el (byte-optimize-form): Use the new
macro to preserve source positions.

* test/lisp/emacs-lisp/bytecomp-resources/bad-error-position.el
* test/lisp/emacs-lisp/bytecomp-resources/bad-error-position-2.el:
New test files.
* test/lisp/emacs-lisp/bytecomp-tests.el: Two new tests using
the new test files.
This commit is contained in:
Alan Mackenzie 2025-07-13 20:28:51 +00:00
parent 1e3d76af5a
commit c44903b011
5 changed files with 148 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
lisp/emacs-lisp/byte-opt.el
View file

@ -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))))))))

110
lisp/emacs-lisp/macroexp.el
View file

@ -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

19
test/lisp/emacs-lisp/bytecomp-resources/macro-warning-position-2.el Normal file
View file

@ -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))))

19
test/lisp/emacs-lisp/bytecomp-resources/macro-warning-position.el Normal file
View file

@ -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))))

5
test/lisp/emacs-lisp/bytecomp-tests.el
View file

@ -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.