From e93f3f44cc31a47e54c301157ce91f1b4d79e57e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
Date: Mon, 22 Nov 2021 16:56:38 +0100
Subject: [PATCH 2/2] Improved closure-conversion of shadowed captured
 lambda-lifted vars

* lisp/emacs-lisp/cconv.el (cconv-convert):
Eliminate the intermediate variable `closed-VAR` when the shadowed
variable is captured in an outer closure, since the accessor can be
used directly (bug#51982).

* test/lisp/emacs-lisp/cconv-tests.el (cconv-tests--intern-all)
(cconv-closure-convert-remap-var): Adapt tests.
---
 lisp/emacs-lisp/cconv.el            | 33 ++++++++++++++++-------------
 test/lisp/emacs-lisp/cconv-tests.el | 20 +++++++----------
 2 files changed, 26 insertions(+), 27 deletions(-)

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 9808547b84..a50aab93f2 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -317,8 +317,9 @@ cconv--lifted-arg
        ;; passed "by reference" to the λ-lifted function.
        (cadr mapping))
       ((or '() `(car-safe ,(pred symbolp)))
-       ;; The variable is not captured; use the (shadowed) variable value.
-       var))))
+       ;; The variable is not captured.  Add a reference to the
+       ;; outside binding and arrange to use that reference.
+       (make-symbol (format "closed-%s" var))))))
 
 (defun cconv-convert (form env extend)
   ;; This function actually rewrites the tree.
@@ -441,14 +442,16 @@ cconv-convert
                        (cconv-convert value env extend)))))
 
                (when (and (eq letsym 'let*) (memq var new-extend))
-                 ;; 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))))
-                   (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)))
+                 ;; One of the lambda-lifted vars is shadowed; if
+                 ;; necessary, add a reference to the outside binding
+                 ;; and arrange to use that reference.
+                 (let* ((lifted-arg (cconv--lifted-arg var env)))
+                   ;; This means that we may add accessors to ENV and EXTEND
+                   ;; passing them off as variables, but it's close enough.
+                   (setq new-env (cconv--remap-llv new-env var lifted-arg))
+                   (setq new-extend (cons lifted-arg (remq var new-extend)))
+                   (when (symbolp lifted-arg)
+                     (push `(,lifted-arg ,var) binders-new))))
 
                ;; We push the element after redefined free variables are
                ;; processed.  This is important to avoid the bug when free
@@ -468,11 +471,11 @@ cconv-convert
            (when (memq (car-safe binder) new-extend)
              ;; 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-def) binders-new)))))
+                    (lifted-arg (cconv--lifted-arg var env)))
+               (setq new-env (cconv--remap-llv new-env var lifted-arg))
+               (setq new-extend (cons lifted-arg (remq var new-extend)))
+               (when (symbolp lifted-arg)
+                 (push `(,lifted-arg ,var) binders-new))))))
 
        `(,letsym ,(nreverse binders-new)
                  . ,(mapcar (lambda (form)
diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el
index 0701892b8c..3bd34e08d3 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -267,9 +267,8 @@ cconv-closure-convert-remap-var
                 (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))))))))
+                   (let ((x 'a))
+                     (list x (funcall f (internal-get-closed-var 0)))))))))
   (should (equal
            (cconv-tests--intern-all
             (cconv-closure-convert
@@ -282,9 +281,8 @@ cconv-closure-convert-remap-var
                 (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))))))))
+                   (let* ((x 'a))
+                     (list x (funcall f (internal-get-closed-var 0)))))))))
   ;; With lambda-lifted shadowed variable also being mutably captured:
   (should (equal
            (cconv-tests--intern-all
@@ -302,9 +300,8 @@ cconv-closure-convert-remap-var
                    (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)))))))))
+                     (let ((x 'a))
+                       (list x (funcall f (internal-get-closed-var 0))))))))))
   (should (equal
            (cconv-tests--intern-all
             (cconv-closure-convert
@@ -321,9 +318,8 @@ cconv-closure-convert-remap-var
                    (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)))))))))
+                     (let* ((x 'a))
+                       (list x (funcall f (internal-get-closed-var 0))))))))))
   ;; Lambda-lifted variable that isn't actually captured where it is shadowed:
   (should (equal
            (cconv-tests--intern-all
-- 
2.21.1 (Apple Git-122.3)

