Fix closure-conversion of shadowed captured lambda-lifted vars

Lambda-lifted variables (ones passed explicitly to lambda-lifted
functions) that are also captured in an outer closure and shadowed
were renamed incorrectly (bug#51982).

Reported by Paul Pogonyshev.

* lisp/emacs-lisp/cconv.el (cconv--lifted-arg): New.
(cconv-convert): Provide correct definiens for the closed-over
variable.
* test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases):
* test/lisp/emacs-lisp/cconv-tests.el (cconv-tests--intern-all)
(cconv-closure-convert-remap-var): Add tests.

(cherry picked from commit 45252ad8f932c98a373ef0ab7f3363a3e27ccbe4)

1 files changed, 25 insertions, 6 deletions

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index ccb96d169d5..fb871a9267e 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -304,6 +304,25 @@ 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.
@@ -428,10 +447,11 @@ 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 ((closedsym (make-symbol (format "closed-%s" var))))
+                 (let ((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) binders-new)))
+                   (push `(,closedsym ,var-def) binders-new)))
 
                ;; We push the element after redefined free variables are
                ;; processed.  This is important to avoid the bug when free
@@ -449,14 +469,13 @@ 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, so add
-             ;; a reference to the outside binding and arrange to use
-             ;; that reference.
+             ;; One of the lambda-lifted vars is shadowed.
              (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) binders-new)))))
+               (push `(,closedsym ,var-def) binders-new)))))
 
        `(,letsym ,(nreverse binders-new)
                  . ,(mapcar (lambda (form)