Subject: bug#73725: Master: Wrong position for byte compiler warning message.

From: Alan Mackenzie <[email-masked]>
Date: Wed, 23 Oct 2024 11:22:22 +0000

Hello, Stefan and Mattias.

I've incorporated your (Stafan's) suggestions from yesterday into the
code.  See the patch below.

As for timings, these changes slow down a make bootstrap by around 0.5%,
something barely measurable.

On Tue, Oct 22, 2024 at 09:33:02 -0400, Stefan Monnier wrote:

[ .... ]

> >> > -(defun macroexpand-all (form &optional environment)
> >> > +(defun macroexpand-all (form &optional environment keep-pos)
> >> Any reason why we need this new argument?
> >> Can't we just always try to preserve the positions?
> > There are lots of calls to macroexpand-all (around 37), and I was
> > concerned about possible accidental side effects in these.

> I think we should assume that those potential side effects would more
> likely be beneficial than harmful.

> Another way to look at it is to look at the doc you provided:

>     KEEP-POS, if non-nil, specifies that any symbol-with-position for
>     FORM should be preserved, later to be usable by
>     `byte-compile--warning-source-offset'.

> Even when `keep-pos` is nil, `macroexpand-all` will preserve most of the
> SWPs, so the doc is misleading.

OK, I've removed that extra optional parameter.

> > Also, always trying to preserve the position might slow down
> > compilation, but I haven't measured that yet.

> I think the calls where you currently ask for `keep-pos` account for the
> vast majority of the time spent macro-expanding, so I'd be surprised if
> doing it in all cases would make it measurably worse.

As said above, the slow down this bug fix causes is only just measurable.

Here is the current state of the patch.  I propose committing it to
master.  What do you say, Mattias?

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index d8dbfa62bf9..5cfc3528492 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -509,8 +509,12 @@ byte-optimize-one-form
 (defun byte-optimize-form (form &optional for-effect)
   (while
       (progn
-        ;; First, optimize all sub-forms of this one.
-        (setq form (byte-optimize-form-code-walker form for-effect))
+        ;; First, optimize all sub-forms of this one.  Note that
+        ;; `byte-optimize-form-code-walker' sometimes changes the car of
+        ;; `form', hence the `macroexp-preserve-posification'.
+        (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 +523,8 @@ byte-optimize-form
              (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 053db927b67..1224223993e 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -238,22 +238,101 @@ macroexpand-1
                 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"))
@@ -524,7 +603,9 @@ macroexpand-all
 definitions to shadow the loaded ones for use in file byte-compilation."
   (let ((macroexpand-all-environment environment)
         (macroexp--dynvars macroexp--dynvars))
-    (macroexp--expand-all form)))
+    (macroexp-preserve-posification
+        form
+      (macroexp--expand-all form))))
 
 ;; This function is like `macroexpand-all' but for use with top-level
 ;; forms.  It does not dynbind `macroexp--dynvars' because we want

>         Stefan

-- 
Alan Mackenzie (Nuremberg, Germany).