From 3f8b84fb7315e05aa2a7f601b58c6ea952a13717 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 24 Mar 2025 17:12:16 -0400 Subject: [PATCH] (byte-compile-maybe-guarded): Make its code edebuggable * lisp/emacs-lisp/bytecomp.el (byte-compile--reify-function): Hoist subexpression out of `if`. (byte-compile-variadic-numeric, byte-compile--cond-vars) (byte-compile--cond-switch-prefix, byte-compile-file-form-defalias): Obey `lexical-binding` when evaluating the code we're compiling. (byte-compile--maybe-guarded): New function, extracted from `byte-compile-maybe-guarded`. (byte-compile-maybe-guarded): Use it so we can edebug the code. (cherry picked from commit c26862a6c9f2d46f41b4f91972d139a138cb2edf) --- lisp/emacs-lisp/bytecomp.el | 86 +++++++++++++++++++------------------ 1 file changed, 45 insertions(+), 41 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index fc2c3d37e75..f89bf18094b 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2966,9 +2966,8 @@ FUN should be an interpreted closure." (push `(,(car binding) ',(cdr binding)) renv)) ((eq binding t)) (t (push `(defvar ,binding) body)))) - (if (null renv) - `(lambda ,args ,@preamble ,@body) - `(let ,renv (lambda ,args ,@preamble ,@body))))) + (let ((fun `(lambda ,args ,@preamble ,@body))) + (if renv `(let ,renv ,fun) fun)))) ;;;###autoload (defun byte-compile (form) @@ -4253,7 +4252,7 @@ This function is never called when `lexical-binding' is nil." (pcase (length form) (1 ;; No args: use the identity value for the operation. - (byte-compile-constant (eval form))) + (byte-compile-constant (eval form lexical-binding))) (2 ;; One arg: compile (OP x) as (* x 1). This is identity for ;; all numerical values including -0.0, infinities and NaNs. @@ -4511,39 +4510,42 @@ being undefined (or obsolete) will be suppressed. If CONDITION's value is (not (featurep \\='emacs)) or (featurep \\='xemacs), that suppresses all warnings during execution of BODY." (declare (indent 1) (debug t)) - `(let* ((fbound-list (byte-compile-find-bound-condition - ,condition '(fboundp functionp) - byte-compile-unresolved-functions)) - (bound-list (byte-compile-find-bound-condition - ,condition '(boundp default-boundp local-variable-p))) - (new-bound-list - ;; (seq-difference byte-compile-bound-variables)) - (delq nil (mapcar (lambda (s) - (if (memq s byte-compile-bound-variables) nil s)) - bound-list))) - ;; Maybe add to the bound list. - (byte-compile-bound-variables - (append new-bound-list byte-compile-bound-variables))) - (mapc #'byte-compile--check-prefixed-var new-bound-list) - (unwind-protect - ;; If things not being bound at all is ok, so must them being - ;; obsolete. Note that we add to the existing lists since Tramp - ;; (ab)uses this feature. - ;; FIXME: If `foo' is obsoleted by `bar', the code below - ;; correctly arranges to silence the warnings after testing - ;; existence of `foo', but the warning should also be - ;; silenced after testing the existence of `bar'. - (let ((byte-compile-not-obsolete-vars - (append byte-compile-not-obsolete-vars bound-list)) - (byte-compile-not-obsolete-funcs - (append byte-compile-not-obsolete-funcs fbound-list))) - ,@body) - ;; Maybe remove the function symbol from the unresolved list. - (dolist (fbound fbound-list) - (when fbound - (setq byte-compile-unresolved-functions - (delq (assq fbound byte-compile-unresolved-functions) - byte-compile-unresolved-functions))))))) + `(byte-compile--maybe-guarded ,condition (lambda () ,@body))) + +(defun byte-compile--maybe-guarded (condition body-fun) + (let* ((fbound-list (byte-compile-find-bound-condition + condition '(fboundp functionp) + byte-compile-unresolved-functions)) + (bound-list (byte-compile-find-bound-condition + condition '(boundp default-boundp local-variable-p))) + (new-bound-list + ;; (seq-difference byte-compile-bound-variables)) + (delq nil (mapcar (lambda (s) + (if (memq s byte-compile-bound-variables) nil s)) + bound-list))) + ;; Maybe add to the bound list. + (byte-compile-bound-variables + (append new-bound-list byte-compile-bound-variables))) + (mapc #'byte-compile--check-prefixed-var new-bound-list) + (unwind-protect + ;; If things not being bound at all is ok, so must them being + ;; obsolete. Note that we add to the existing lists since Tramp + ;; (ab)uses this feature. + ;; FIXME: If `foo' is obsoleted by `bar', the code below + ;; correctly arranges to silence the warnings after testing + ;; existence of `foo', but the warning should also be + ;; silenced after testing the existence of `bar'. + (let ((byte-compile-not-obsolete-vars + (append byte-compile-not-obsolete-vars bound-list)) + (byte-compile-not-obsolete-funcs + (append byte-compile-not-obsolete-funcs fbound-list))) + (funcall body-fun)) + ;; Maybe remove the function symbol from the unresolved list. + (dolist (fbound fbound-list) + (when fbound + (setq byte-compile-unresolved-functions + (delq (assq fbound byte-compile-unresolved-functions) + byte-compile-unresolved-functions))))))) (defun byte-compile-if (form) (byte-compile-form (car (cdr form))) @@ -4574,8 +4576,10 @@ that suppresses all warnings during execution of BODY." ;; and the other is a constant expression whose value can be ;; compared with `eq' (with `macroexp-const-p'). (or - (and (symbolp obj1) (macroexp-const-p obj2) (cons obj1 (eval obj2))) - (and (symbolp obj2) (macroexp-const-p obj1) (cons obj2 (eval obj1))))) + (and (symbolp obj1) (macroexp-const-p obj2) + (cons obj1 (eval obj2 lexical-binding))) + (and (symbolp obj2) (macroexp-const-p obj1) + (cons obj2 (eval obj1 lexical-binding))))) (defun byte-compile--common-test (test-1 test-2) "Most specific common test of `eq', `eql' and `equal'." @@ -4628,7 +4632,7 @@ Return (TAIL VAR TEST CASES), where: ;; Require a non-empty body, since the member ;; function value depends on the switch argument. body - (let ((value (eval expr))) + (let ((value (eval expr lexical-binding))) (and (proper-list-p value) (progn (setq switch-var var) @@ -5197,7 +5201,7 @@ binding slots have been popped." (if (null fun) (message "Macro %s unrecognized, won't work in file" name) (message "Macro %s partly recognized, trying our luck" name) - (push (cons name (eval fun)) + (push (cons name (eval fun lexical-binding)) byte-compile-macro-environment))) (byte-compile-keep-pending form)))) -- 2.39.5