unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: "Mattias Engdegård" <mattiase@acm.org>
To: Michael Heerdegen <michael_heerdegen@web.de>
Cc: Paul Pogonyshev <pogonyshev@gmail.com>,
	51982@debbugs.gnu.org, Stefan Monnier <monnier@iro.umontreal.ca>
Subject: bug#51982: Erroneous handling of local variables in byte-compiled nested lambdas
Date: Mon, 22 Nov 2021 18:35:18 +0100	[thread overview]
Message-ID: <ED0329E9-B3EF-4F2A-AD7A-329B9A382D9E@acm.org> (raw)
In-Reply-To: <CBD8F94A-ACD8-4540-AF1F-7FB9D8F01B0B@acm.org>

[-- Attachment #1: Type: text/plain, Size: 1526 bytes --]

> I just found a case where it doesn't work. A repaired patch will arrive soon (we hope).

Not one but two patches for your enjoyment, representing two alternative solutions. Patch A is an extension of the original proposal and is simpler but perhaps less performant; patch B is messier but may result in better code.

To connect to the previous example, cconv transforms the function

(defun f (x)
  (lambda ()
    (let ((f (lambda () x)))
      (let ((x 'a))
        (list x (funcall f))))))

with patch A into

(defun f (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))))))

and with patch B into

(defun f (x)
  (internal-make-closure
   nil (x) nil
   (let ((f (lambda (x) x)))
     (let ((x 'a))
       (list x (funcall f (internal-get-closed-var 0)))))))

This looks like a wash but the optimiser isn't able to elide that superfluous closed-x variable yet, and in Paul's original example the captured variable is only used in one conditional branch which makes it a loss to bind it up-front whereas it's very cheap to materialise at the call site (a single constant-pushing byte op).

On the other hand, patch B does abuse the cconv data structures a little (but it works!). We'll see if Stefan can stomach it.

(This reminds me: we should probably declare internal-get-closed-var as pure and error-free, even though it's not even an actual function.)


[-- Attachment #2: bug51982-A.patch --]
[-- Type: application/octet-stream, Size: 14087 bytes --]

From e3b306c9748c8738ed9086fb81562031865dffda 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] Fix closure-conversion of shadowed captured lambda-lifted
 vars

* lisp/emacs-lisp/cconv.el (cconv-convert):
Lambda lifted variables (ones passed explicitly to lambda-lifted
functions) that are also captured in an outer closure and shadowed
were renamed incorrectly.  Fix that by providing the correct
definiens for the closed-over variable (bug#51982).

* 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.
---
 lisp/emacs-lisp/cconv.el               |  52 +++++++--
 test/lisp/emacs-lisp/bytecomp-tests.el |  41 +++++++
 test/lisp/emacs-lisp/cconv-tests.el    | 152 +++++++++++++++++++++++++
 3 files changed, 234 insertions(+), 11 deletions(-)

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 03e109f250..34663937cc 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -428,10 +428,26 @@ cconv-convert
                  ;; 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))))
-                   (setq new-env (cconv--remap-llv new-env var closedsym))
-                   (setq new-extend (cons closedsym (remq var new-extend)))
-                   (push `(,closedsym ,var) binders-new)))
+                 (let* ((mapping (cdr (assq var env)))
+                        (var-def
+                         (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 rerefence" to the λ-lifted function.
+                            (cadr mapping))
+                           ((or '() `(car-safe ,(pred symbolp)))
+                            ;; The variable is not captured.  Add a
+                            ;; reference to the outside binding and arrange
+                            ;; to use that reference.
+                            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))))
 
                ;; We push the element after redefined free variables are
                ;; processed.  This is important to avoid the bug when free
@@ -449,14 +465,28 @@ cconv-convert
          ;; 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))
-                    (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)))))
+                    (mapping (cdr (assq var env)))
+                    (var-def
+                     (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 rerefence" to the λ-lifted function.
+                        (cadr mapping))
+                       ((or '() `(car-safe ,(pred symbolp)))
+                        ;; The variable is not captured.  Add a
+                        ;; reference to the outside binding and
+                        ;; arrange to use that reference.
+                        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))))))
 
        `(,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 dbc0aa3db4..c427cd7536 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -643,6 +643,47 @@ bytecomp-tests--test-cases
 
     (cond)
     (mapcar (lambda (x) (cond ((= x 0)))) '(0 1))
+
+    ;; These expressions give different results in lexbind and dynbind modes,
+    ;; but in each the compiler and interpreter should agree!
+    (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 x)
+                   (let ((x 'a))
+                     (list x (funcall g))))))))
+      (funcall (funcall f 'b)))
+    (let ((f (lambda (x)
+               (lambda ()
+                 (let ((g (lambda () x)))
+                   (setq 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 x))))
+                 (let ((x 'b))
+                   (list x (funcall g) (funcall h)))))))
+      (funcall (funcall f 'b)))
+    (let ((f (lambda (x)
+               (let ((g (lambda () x))
+                     (h (lambda () (setq x x))))
+                 (let* ((x 'b))
+                   (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 4290571735..0701892b8c 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -205,5 +205,157 @@ cconv-convert-lambda-lifted
            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
-- 
2.21.1 (Apple Git-122.3)


[-- Attachment #3: bug51982-B.patch --]
[-- Type: application/octet-stream, Size: 14039 bytes --]

From 3bcad5e4c21f94cc91a397685848f1887ac21207 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] Fix closure-conversion of shadowed captured lambda-lifted
 vars

* lisp/emacs-lisp/cconv.el (cconv-convert):
Lambda lifted variables (ones passed explicitly to lambda-lifted
functions) that are also captured in an outer closure and shadowed
were renamed incorrectly.  Fix that by dropping the renaming
since it's not needed for captured variables (bug#51982).

* 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.
---
 lisp/emacs-lisp/cconv.el               |  54 +++++++--
 test/lisp/emacs-lisp/bytecomp-tests.el |  41 +++++++
 test/lisp/emacs-lisp/cconv-tests.el    | 148 +++++++++++++++++++++++++
 3 files changed, 232 insertions(+), 11 deletions(-)

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 03e109f250..8989bd412f 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -428,10 +428,27 @@ cconv-convert
                  ;; 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))))
-                   (setq new-env (cconv--remap-llv new-env var closedsym))
-                   (setq new-extend (cons closedsym (remq var new-extend)))
-                   (push `(,closedsym ,var) binders-new)))
+                 (let* ((mapping (cdr (assq var env)))
+                        (remap-to
+                         (pcase-exhaustive mapping
+                           (`(internal-get-closed-var . ,_)
+                            ;; The variable is captured; remap.
+                            mapping)
+                           (`(car-safe (internal-get-closed-var . ,_))
+                            ;; The variable is mutably captured; remap, but skip
+                            ;; the indirection step because the variable is
+                            ;; passed "by rerefence" to the λ-lifted function.
+                            (cadr mapping))
+                           ((or '() `(car-safe ,(pred symbolp)))
+                            ;; The variable is not captured.  Add a
+                            ;; reference to the outside binding and arrange
+                            ;; to use that reference.
+                            (let ((closedsym
+                                   (make-symbol (format "closed-%s" var))))
+                              (push `(,closedsym ,var) binders-new)
+                              closedsym)))))
+                   (setq new-env (cconv--remap-llv new-env var remap-to))
+                   (setq new-extend (cons remap-to (remq var new-extend)))))
 
                ;; We push the element after redefined free variables are
                ;; processed.  This is important to avoid the bug when free
@@ -449,14 +466,29 @@ cconv-convert
          ;; 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))
-                    (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)))))
+                    (mapping (cdr (assq var env)))
+                    (remap-to
+                     (pcase-exhaustive mapping
+                       (`(internal-get-closed-var . ,_)
+                        ;; The variable is captured; remap.
+                        mapping)
+                       (`(car-safe (internal-get-closed-var . ,_))
+                        ;; The variable is mutably captured; remap, but skip
+                        ;; the indirection step because the variable is
+                        ;; passed "by rerefence" to the λ-lifted function.
+                        (cadr mapping))
+                       ((or '() `(car-safe ,(pred symbolp)))
+                        ;; The variable is not captured.  Add a
+                        ;; reference to the outside binding and arrange
+                        ;; to use that reference.
+                        (let ((closedsym
+                               (make-symbol (format "closed-%s" var))))
+                          (push `(,closedsym ,var) binders-new)
+                          closedsym)))))
+               (setq new-env (cconv--remap-llv new-env var remap-to))
+               (setq new-extend (cons remap-to (remq var new-extend)))))))
 
        `(,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 dbc0aa3db4..c427cd7536 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -643,6 +643,47 @@ bytecomp-tests--test-cases
 
     (cond)
     (mapcar (lambda (x) (cond ((= x 0)))) '(0 1))
+
+    ;; These expressions give different results in lexbind and dynbind modes,
+    ;; but in each the compiler and interpreter should agree!
+    (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 x)
+                   (let ((x 'a))
+                     (list x (funcall g))))))))
+      (funcall (funcall f 'b)))
+    (let ((f (lambda (x)
+               (lambda ()
+                 (let ((g (lambda () x)))
+                   (setq 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 x))))
+                 (let ((x 'b))
+                   (list x (funcall g) (funcall h)))))))
+      (funcall (funcall f 'b)))
+    (let ((f (lambda (x)
+               (let ((g (lambda () x))
+                     (h (lambda () (setq x x))))
+                 (let* ((x 'b))
+                   (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 4290571735..3bd34e08d3 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -205,5 +205,153 @@ cconv-convert-lambda-lifted
            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))
+                     (list x (funcall f (internal-get-closed-var 0)))))))))
+  (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))
+                     (list x (funcall f (internal-get-closed-var 0)))))))))
+  ;; 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))
+                       (list x (funcall f (internal-get-closed-var 0))))))))))
+  (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))
+                       (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
+            (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
-- 
2.21.1 (Apple Git-122.3)


  reply	other threads:[~2021-11-22 17:35 UTC|newest]

Thread overview: 22+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-11-19 20:31 bug#51982: Erroneous handling of local variables in byte-compiled nested lambdas Paul Pogonyshev
2021-11-20  4:44 ` Michael Heerdegen
2021-11-20  8:45   ` Mattias Engdegård
2021-11-20 10:51     ` Michael Heerdegen
2021-11-20 16:54   ` Paul Pogonyshev
2021-11-20 17:04     ` Mattias Engdegård
2021-11-20 17:22       ` Paul Pogonyshev
2021-11-20 18:34         ` Mattias Engdegård
2021-11-20 20:53           ` Paul Pogonyshev
2021-11-21  7:59         ` Michael Heerdegen
2021-11-21  9:59           ` Mattias Engdegård
2021-11-22 10:29             ` Michael Heerdegen
2021-11-22 13:56               ` Mattias Engdegård
2021-11-22 17:35                 ` Mattias Engdegård [this message]
2021-11-30 14:12                   ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-30 17:01                     ` Mattias Engdegård
2021-11-30 22:41                       ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-12-01 16:04                         ` Mattias Engdegård
2021-12-01 18:34                           ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-12-01 22:32                             ` Mattias Engdegård
2021-12-02  9:13                               ` Mattias Engdegård
2022-09-09 17:59                                 ` Lars Ingebrigtsen

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=ED0329E9-B3EF-4F2A-AD7A-329B9A382D9E@acm.org \
    --to=mattiase@acm.org \
    --cc=51982@debbugs.gnu.org \
    --cc=michael_heerdegen@web.de \
    --cc=monnier@iro.umontreal.ca \
    --cc=pogonyshev@gmail.com \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).