From: "Mattias Engdegård" <mattiase@acm.org>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: Michael Heerdegen <michael_heerdegen@web.de>,
Paul Pogonyshev <pogonyshev@gmail.com>,
51982@debbugs.gnu.org
Subject: bug#51982: Erroneous handling of local variables in byte-compiled nested lambdas
Date: Tue, 30 Nov 2021 18:01:59 +0100 [thread overview]
Message-ID: <B51CEFD1-DFDF-4C78-93AB-254278776E47@acm.org> (raw)
In-Reply-To: <jwvfsrdkaf8.fsf-monnier+emacs@gnu.org>
[-- Attachment #1: Type: text/plain, Size: 1972 bytes --]
30 nov. 2021 kl. 15.12 skrev Stefan Monnier <monnier@iro.umontreal.ca>:
> Can we avoid this duplication by moving that code to a separate function?
I extracted a big part of the code into a common function but left the free variable access and mutation outside. (Really want to get rid of `let*`!)
> These two tests are identical aren't they?
No, they exercise different code paths (let and let*).
> Also, can we change the
> (setq x x) into something like (setq x (list x x)) and avoid using the
> same `b` value for both `x` vars, so as to catch more potential errors?
Yes, thank you, it was an editing mistake. Fixed.
> Looks good (better than patch A).
And here I was prepared to apply patch A since it's slightly more conservative and it seems to be a rare problem anyway.
I've now split the patches in a more sensible (and easily reviewed) way: the first corresponds to patch A, and the second is the diff to B. Take a second look before making up your mind.
> You say "On the other hand, patch B does abuse the cconv data structures
> a little (but it works!)" so the code should say something about
> this abuse. A least I failed to see where the abuse lies.
There are comments and doc strings such as
EXTEND is a list of variables which might need to be accessed even from places
where they are shadowed, because some part of ENV causes them to be used at
places where they originally did not directly appear.
but with the B patch we put things into `extend` that are not strictly variables but (international-get-closed-var N).
Similarly, `env` has entries like (VAR . (apply-partially F ARG1 ARG2 ..)) where the ARGi are always treated as variables but now they can be access forms as well.
I suppose it doesn't matter much. There is an assertion at the very top of `cconv-convert` which compares the elements by `eq` but it seems to work all right...
Thanks for the review – new patches attached.
[-- Attachment #2: 0001-Fix-closure-conversion-of-shadowed-captured-lambda-l.patch --]
[-- Type: application/octet-stream, Size: 12978 bytes --]
From b56b04ac23f74dddd4648c9f86c8cf7423f70829 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 1/2] Fix closure-conversion of shadowed captured lambda-lifted
vars
* lisp/emacs-lisp/cconv.el (cconv--lifted-arg): New.
(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 | 28 ++++-
test/lisp/emacs-lisp/bytecomp-tests.el | 41 +++++++
test/lisp/emacs-lisp/cconv-tests.el | 152 +++++++++++++++++++++++++
3 files changed, 215 insertions(+), 6 deletions(-)
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 03e109f250..9808547b84 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -304,6 +304,22 @@ cconv--convert-funcbody
`(,@(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."
+ (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.
+ 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 +444,11 @@ 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))))
+ (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 +466,13 @@ 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))
+ (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)
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 816f14a18d..a75a33b2dc 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 (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 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: 0002-Improved-closure-conversion-of-shadowed-captured-lam.patch --]
[-- Type: application/octet-stream, Size: 6664 bytes --]
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)
next prev parent reply other threads:[~2021-11-30 17:01 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
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 [this message]
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=B51CEFD1-DFDF-4C78-93AB-254278776E47@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).