Revert "Fix closure-conversion of shadowed captured lambda-lifted vars"

This reverts commit 3ec8c8b3ae2359ceb8135b672e86526969c16b7e.

It was committed to a stable branch without prior discussion;
see bug#53071.

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index fb871a9267e0a64e2efb136fc01623b685746a1a..ccb96d169d527b6a1757a398e57592162179a06a 100644 (file)
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -304,25 +304,6 @@ of converted forms."
             `(,@(nreverse special-forms) ,@(macroexp-unprogn body))))
       funcbody)))
 
-(defun cconv--lifted-arg (var env)
-  "The argument to use for VAR in λ-lifted calls according to ENV.
-This is used when VAR is being shadowed; we may still need its value for
-such calls."
-  (let ((mapping (cdr (assq var env))))
-    (pcase-exhaustive mapping
-      (`(internal-get-closed-var . ,_)
-       ;; The variable is captured.
-       mapping)
-      (`(car-safe (internal-get-closed-var . ,_))
-       ;; The variable is mutably captured; skip
-       ;; the indirection step because the variable is
-       ;; passed "by reference" to the λ-lifted function.
-       (cadr mapping))
-      ((or '() `(car-safe ,(pred symbolp)))
-       ;; The variable is not captured; use the (shadowed) variable value.
-       ;; (If the mapping is `(car-safe SYMBOL)', SYMBOL is always VAR.
-       var))))
-
 (defun cconv-convert (form env extend)
   ;; This function actually rewrites the tree.
   "Return FORM with all its lambdas changed so they are closed.
@@ -447,11 +428,10 @@ places where they originally did not directly appear."
                  ;; One of the lambda-lifted vars is shadowed, so add
                  ;; a reference to the outside binding and arrange to use
                  ;; that reference.
-                 (let ((var-def (cconv--lifted-arg var env))
-                       (closedsym (make-symbol (format "closed-%s" var))))
+                 (let ((closedsym (make-symbol (format "closed-%s" var))))
                    (setq new-env (cconv--remap-llv new-env var closedsym))
                    (setq new-extend (cons closedsym (remq var new-extend)))
-                   (push `(,closedsym ,var-def) binders-new)))
+                   (push `(,closedsym ,var) binders-new)))
 
                ;; We push the element after redefined free variables are
                ;; processed.  This is important to avoid the bug when free
@@ -469,13 +449,14 @@ places where they originally did not directly appear."
          ;; before we know that the var will be in `new-extend' (bug#24171).
          (dolist (binder binders-new)
            (when (memq (car-safe binder) new-extend)
-             ;; One of the lambda-lifted vars is shadowed.
+             ;; One of the lambda-lifted vars is shadowed, so add
+             ;; a reference to the outside binding and arrange to use
+             ;; that reference.
              (let* ((var (car-safe binder))
-                    (var-def (cconv--lifted-arg var env))
                     (closedsym (make-symbol (format "closed-%s" var))))
                (setq new-env (cconv--remap-llv new-env var closedsym))
                (setq new-extend (cons closedsym (remq var new-extend)))
-               (push `(,closedsym ,var-def) binders-new)))))
+               (push `(,closedsym ,var) binders-new)))))
 
        `(,letsym ,(nreverse binders-new)
                  . ,(mapcar (lambda (form)

diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index b59147453819c8b89abcea7f87f6eb57e447a620..8a09c5459140e05746e74113859f9bf0a48182e4 100644 (file)
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -640,49 +640,6 @@ inner loops respectively."
            (f (list (lambda (x) (setq a x)))))
       (funcall (car f) 3)
       (list a b))
-
-    ;; These expressions give different results in lexbind and dynbind modes,
-    ;; but in each the compiler and interpreter should agree!
-    ;; (They look much the same but come in pairs exercising both the
-    ;; `let' and `let*' paths.)
-    (let ((f (lambda (x)
-               (lambda ()
-                 (let ((g (lambda () x)))
-                   (let ((x 'a))
-                     (list x (funcall g))))))))
-      (funcall (funcall f 'b)))
-    (let ((f (lambda (x)
-               (lambda ()
-                 (let ((g (lambda () x)))
-                   (let* ((x 'a))
-                     (list x (funcall g))))))))
-      (funcall (funcall f 'b)))
-    (let ((f (lambda (x)
-               (lambda ()
-                 (let ((g (lambda () x)))
-                   (setq x (list x x))
-                   (let ((x 'a))
-                     (list x (funcall g))))))))
-      (funcall (funcall f 'b)))
-    (let ((f (lambda (x)
-               (lambda ()
-                 (let ((g (lambda () x)))
-                   (setq x (list x x))
-                   (let* ((x 'a))
-                     (list x (funcall g))))))))
-      (funcall (funcall f 'b)))
-    (let ((f (lambda (x)
-               (let ((g (lambda () x))
-                     (h (lambda () (setq x (list x x)))))
-                 (let ((x 'a))
-                   (list x (funcall g) (funcall h)))))))
-      (funcall (funcall f 'b)))
-    (let ((f (lambda (x)
-               (let ((g (lambda () x))
-                     (h (lambda () (setq x (list x x)))))
-                 (let* ((x 'a))
-                   (list x (funcall g) (funcall h)))))))
-      (funcall (funcall f 'b)))
     )
   "List of expressions for cross-testing interpreted and compiled code.")
 

diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el
index a3bc690541dc8614d1437a07195f0dd33bf22069..edb746cdecf37ec2697cd416eac52583a50641a3 100644 (file)
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -205,157 +205,5 @@
            nil 99)
           42)))
 
-(defun cconv-tests--intern-all (x)
-  "Intern all symbols in X."
-  (cond ((symbolp x) (intern (symbol-name x)))
-        ((consp x) (cons (cconv-tests--intern-all (car x))
-                         (cconv-tests--intern-all (cdr x))))
-        ;; Assume we don't need to deal with vectors etc.
-        (t x)))
-
-(ert-deftest cconv-closure-convert-remap-var ()
-  ;; Verify that we correctly remap shadowed lambda-lifted variables.
-
-  ;; We intern all symbols for ease of comparison; this works because
-  ;; the `cconv-closure-convert' result should contain no pair of
-  ;; distinct symbols having the same name.
-
-  ;; Sanity check: captured variable, no lambda-lifting or shadowing:
-  (should (equal (cconv-tests--intern-all
-           (cconv-closure-convert
-            '#'(lambda (x)
-                 #'(lambda () x))))
-           '#'(lambda (x)
-                (internal-make-closure
-                 nil (x) nil
-                 (internal-get-closed-var 0)))))
-
-  ;; Basic case:
-  (should (equal (cconv-tests--intern-all
-                  (cconv-closure-convert
-                   '#'(lambda (x)
-                        (let ((f #'(lambda () x)))
-                          (let ((x 'b))
-                            (list x (funcall f)))))))
-                 '#'(lambda (x)
-                      (let ((f #'(lambda (x) x)))
-                        (let ((x 'b)
-                              (closed-x x))
-                          (list x (funcall f closed-x)))))))
-  (should (equal (cconv-tests--intern-all
-                  (cconv-closure-convert
-                   '#'(lambda (x)
-                        (let ((f #'(lambda () x)))
-                          (let* ((x 'b))
-                            (list x (funcall f)))))))
-                 '#'(lambda (x)
-                      (let ((f #'(lambda (x) x)))
-                        (let* ((closed-x x)
-                               (x 'b))
-                          (list x (funcall f closed-x)))))))
-
-  ;; With the lambda-lifted shadowed variable also being captured:
-  (should (equal
-           (cconv-tests--intern-all
-            (cconv-closure-convert
-             '#'(lambda (x)
-                  #'(lambda ()
-                      (let ((f #'(lambda () x)))
-                        (let ((x 'a))
-                          (list x (funcall f))))))))
-           '#'(lambda (x)
-                (internal-make-closure
-                 nil (x) nil
-                 (let ((f #'(lambda (x) x)))
-                   (let ((x 'a)
-                         (closed-x (internal-get-closed-var 0)))
-                     (list x (funcall f closed-x))))))))
-  (should (equal
-           (cconv-tests--intern-all
-            (cconv-closure-convert
-             '#'(lambda (x)
-                  #'(lambda ()
-                      (let ((f #'(lambda () x)))
-                        (let* ((x 'a))
-                          (list x (funcall f))))))))
-           '#'(lambda (x)
-                (internal-make-closure
-                 nil (x) nil
-                 (let ((f #'(lambda (x) x)))
-                   (let* ((closed-x (internal-get-closed-var 0))
-                          (x 'a))
-                     (list x (funcall f closed-x))))))))
-  ;; With lambda-lifted shadowed variable also being mutably captured:
-  (should (equal
-           (cconv-tests--intern-all
-            (cconv-closure-convert
-             '#'(lambda (x)
-                  #'(lambda ()
-                      (let ((f #'(lambda () x)))
-                        (setq x x)
-                        (let ((x 'a))
-                          (list x (funcall f))))))))
-           '#'(lambda (x)
-                (let ((x (list x)))
-                  (internal-make-closure
-                   nil (x) nil
-                   (let ((f #'(lambda (x) (car-safe x))))
-                     (setcar (internal-get-closed-var 0)
-                             (car-safe (internal-get-closed-var 0)))
-                     (let ((x 'a)
-                           (closed-x (internal-get-closed-var 0)))
-                       (list x (funcall f closed-x)))))))))
-  (should (equal
-           (cconv-tests--intern-all
-            (cconv-closure-convert
-             '#'(lambda (x)
-                  #'(lambda ()
-                      (let ((f #'(lambda () x)))
-                        (setq x x)
-                        (let* ((x 'a))
-                          (list x (funcall f))))))))
-           '#'(lambda (x)
-                (let ((x (list x)))
-                  (internal-make-closure
-                   nil (x) nil
-                   (let ((f #'(lambda (x) (car-safe x))))
-                     (setcar (internal-get-closed-var 0)
-                             (car-safe (internal-get-closed-var 0)))
-                     (let* ((closed-x (internal-get-closed-var 0))
-                            (x 'a))
-                       (list x (funcall f closed-x)))))))))
-  ;; Lambda-lifted variable that isn't actually captured where it is shadowed:
-  (should (equal
-           (cconv-tests--intern-all
-            (cconv-closure-convert
-             '#'(lambda (x)
-                  (let ((g #'(lambda () x))
-                        (h #'(lambda () (setq x x))))
-                    (let ((x 'b))
-                      (list x (funcall g) (funcall h)))))))
-           '#'(lambda (x)
-                (let ((x (list x)))
-                  (let ((g #'(lambda (x) (car-safe x)))
-                        (h #'(lambda (x) (setcar x (car-safe x)))))
-                    (let ((x 'b)
-                          (closed-x x))
-                      (list x (funcall g closed-x) (funcall h closed-x))))))))
-  (should (equal
-           (cconv-tests--intern-all
-            (cconv-closure-convert
-             '#'(lambda (x)
-                  (let ((g #'(lambda () x))
-                        (h #'(lambda () (setq x x))))
-                    (let* ((x 'b))
-                      (list x (funcall g) (funcall h)))))))
-           '#'(lambda (x)
-                (let ((x (list x)))
-                  (let ((g #'(lambda (x) (car-safe x)))
-                        (h #'(lambda (x) (setcar x (car-safe x)))))
-                    (let* ((closed-x x)
-                           (x 'b))
-                      (list x (funcall g closed-x) (funcall h closed-x))))))))
-  )
-
 (provide 'cconv-tests)
 ;;; cconv-tests.el ends here