]> git.eshelyaron.com Git - emacs.git/commitdiff
(byte-compile-maybe-guarded): Make its code edebuggable
authorStefan Monnier <monnier@iro.umontreal.ca>
Mon, 24 Mar 2025 21:12:16 +0000 (17:12 -0400)
committerEshel Yaron <me@eshelyaron.com>
Tue, 25 Mar 2025 18:19:12 +0000 (19:19 +0100)
* 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

index fc2c3d37e75160bad0528f9851cc70f68792678d..f89bf18094b570e45a66c7b0c035749de2c150a4 100644 (file)
@@ -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))))
 \f
 ;;;###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))))