master 2114a955c23: Preserve source position of macro calls in macro expansions

[Alan Mackenzie]

branch: master
commit 2114a955c23c213168f012f5e480edae46561fd2
Author: Alan Mackenzie <acm@muc.de>
Commit: Alan Mackenzie <acm@muc.de>

    Preserve source position of macro calls in macro expansions
    
    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 (sub-macroexp--posify-form)
    (macroexp--posify-form): New functions.
    (macroexp-preserve-posification): New macro.
    (macroexp-macroexpand): Use the new macro to preserve a calling
    form's position.
    (macroexpand-all): Add a new parameter `keep-pos' which
    instructs the function to preserve an invoking form's position.
    
    * lisp/emacs-lisp/byte-opt.el (byte-optimize-form): Use the new
    macro to preserve source positions.
    
    * lisp/emacs-lisp/bytecomp.el (byte-compile-preprocess): Call
    macroexpand-all with the new argument `keep-pos' non-nil.
---
 lisp/emacs-lisp/byte-opt.el |   7 ++-
 lisp/emacs-lisp/bytecomp.el |   2 +-
 lisp/emacs-lisp/macroexp.el | 106 ++++++++++++++++++++++++++++++++++++--------
 3 files changed, 94 insertions(+), 21 deletions(-)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index d8dbfa62bf9..669b6c76417 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -510,7 +510,9 @@ 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))
+        (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 +521,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/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 29e7882c851..4272a6fb252 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2582,7 +2582,7 @@ Call from the source buffer."
               byte-compile-jump-tables nil))))
 
 (defun byte-compile-preprocess (form &optional _for-effect)
-  (setq form (macroexpand-all form byte-compile-macro-environment))
+  (setq form (macroexpand-all form byte-compile-macro-environment t))
   ;; FIXME: We should run byte-optimize-form here, but it currently does not
   ;; recurse through all the code, so we'd have to fix this first.
   ;; Maybe a good fix would be to merge byte-optimize-form into
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 053db927b67..0b19544652a 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -238,22 +238,85 @@ It should normally be a symbol with position and it 
defaults to FORM."
                 form))))))))
    (t form)))
 
+(defun sub-macroexp--posify-form (form call-pos depth)
+  "Try to apply the transformation of `macroexp--posify-form' to FORM.
+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 changed form, or nil if no change happened."
+  (let (new-form)
+    (cond
+     ((zerop depth) nil)
+     ((and (consp form)
+           (symbolp (car form))
+           (car form))
+      (setcar form (position-symbol (car form) call-pos))
+      form)
+     ((consp form)
+      (or (when (setq new-form (sub-macroexp--posify-form
+                                (car form) call-pos (1- depth)))
+            (setcar form new-form)
+            form)
+          (when (setq new-form (sub-macroexp--posify-form
+                                (cdr form) call-pos (1- depth)))
+            (setcdr form new-form)
+            form)))
+     ((symbolp form)
+      (if form                          ; Don't position nil!
+          (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 (sub-macroexp--posify-form
+                                         (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.
+CALL-POS is a buffer position, a number.  FORM may be any lisp form,
+and is typically the output form returned by macro expansion.
+Apply CALL-POS to FORM as a symbol with position, such that
+`byte-compile--first-symbol-with-pos' can later return it.  Return
+the possibly modified FORM."
+  (let ((new-form (sub-macroexp--posify-form 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."
+  `(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 call-pos
+         (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))))
+       (setq macroexpanded t)
+       (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))))
+     new-form)))
 
 (defun macroexp--unfold-lambda (form &optional name)
   (or name (setq name "anonymous lambda"))
@@ -517,14 +580,21 @@ Assumes the caller has bound 
`macroexpand-all-environment'."
             (_ form))))))
 
 ;;;###autoload
-(defun macroexpand-all (form &optional environment)
+(defun macroexpand-all (form &optional environment keep-pos)
   "Return result of expanding macros at all levels in FORM.
-If no macros are expanded, FORM is returned unchanged.
-The second optional arg ENVIRONMENT specifies an environment of macro
-definitions to shadow the loaded ones for use in file byte-compilation."
-  (let ((macroexpand-all-environment environment)
+If no macros are expanded, FORM is returned unchanged.  The second
+optional arg ENVIRONMENT specifies an environment of macro definitions
+to shadow the loaded ones for use in file byte-compilation.  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'."
+  (let*
+      ((macroexpand-all-environment environment)
         (macroexp--dynvars macroexp--dynvars))
-    (macroexp--expand-all form)))
+    (if keep-pos
+        (macroexp-preserve-posification
+         form
+         (macroexp--expand-all 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