From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Alan Mackenzie Newsgroups: gmane.emacs.bugs Subject: bug#73746: bug#73725: Master: Wrong position for byte compiler warning message. Date: Wed, 23 Oct 2024 11:22:22 +0000 Message-ID: References: <8A05D4D2-C77B-4089-B82C-4DB3E88F1276@gmail.com> Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="30525"; mail-complaints-to="usenet@ciao.gmane.io" Cc: 73746@debbugs.gnu.org, acm@muc.de, 73725@debbugs.gnu.org To: Stefan Monnier , Mattias =?UTF-8?Q?Engdeg=C3=A5rd?= Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Wed Oct 23 13:24:28 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1t3ZTX-0007mX-EF for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 23 Oct 2024 13:24:27 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1t3ZSk-0005ES-89; Wed, 23 Oct 2024 07:23:38 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1t3ZSf-0005E0-UU for bug-gnu-emacs@gnu.org; Wed, 23 Oct 2024 07:23:34 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1t3ZSf-0001XM-Lh for bug-gnu-emacs@gnu.org; Wed, 23 Oct 2024 07:23:33 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=From:In-Reply-To:MIME-Version:References:Date:To:Subject; bh=adyS3HRPsZTEGPqSDniFahhVvgwfY0jV/710aRvh11s=; b=dSz0Y171KJQmhNg/GQO8HrFi3jnVc7Tfv0KvKhVnginvFT28M8MnOd1tmdbJyZcF7OG+ZIzTSGAJjjhITV++M9lNW7LCi7NI4S7aTE8koWHIOANNkw20gp0clMcsf9Z+ByALOxWIQY5nBR1ffrdk7yx01XfA4BErOTaxruRsqz0UDzXyF9/mS1FPdjwEh6vED0VLivoFWczMnq3/TdoJE5p2ZUX1XnYBbkI1kA654ugHgu0QTocA3vIV3skgu3Q9iUGfdmcJZke+IKBMs8Fnfyu+Xr2Pjmu1qpGbYNwWdRPb9RHALO3/nuaqo64okRa3MuFVWkcRepmTYwm6C/uesQ==; Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1t3ZT8-0006md-Od for bug-gnu-emacs@gnu.org; Wed, 23 Oct 2024 07:24:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Alan Mackenzie Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 23 Oct 2024 11:24:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73746 X-GNU-PR-Package: emacs Original-Received: via spool by 73746-submit@debbugs.gnu.org id=B73746.172968258325958 (code B ref 73746); Wed, 23 Oct 2024 11:24:02 +0000 Original-Received: (at 73746) by debbugs.gnu.org; 23 Oct 2024 11:23:03 +0000 Original-Received: from localhost ([127.0.0.1]:58802 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3ZSA-0006kb-QD for submit@debbugs.gnu.org; Wed, 23 Oct 2024 07:23:03 -0400 Original-Received: from mail.muc.de ([193.149.48.3]:45669) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3ZS8-0006jy-6J for 73746@debbugs.gnu.org; Wed, 23 Oct 2024 07:23:01 -0400 Original-Received: (qmail 31957 invoked by uid 3782); 23 Oct 2024 13:22:23 +0200 Original-Received: from muc.de (pd953aa34.dip0.t-ipconnect.de [217.83.170.52]) (using STARTTLS) by colin.muc.de (tmda-ofmipd) with ESMTP; Wed, 23 Oct 2024 13:22:23 +0200 Original-Received: (qmail 10533 invoked by uid 1000); 23 Oct 2024 11:22:23 -0000 Content-Disposition: inline In-Reply-To: X-Submission-Agent: TMDA/1.3.x (Ph3nix) X-Primary-Address: acm@muc.de X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:294141 Archived-At: 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).