From 22ddd2ba13ae002a23f41ae543e211a06a85ad8f Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 12 Jan 2022 19:47:39 +0100 Subject: [PATCH] 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. --- lisp/emacs-lisp/cconv.el | 31 +---- test/lisp/emacs-lisp/bytecomp-tests.el | 43 ------- test/lisp/emacs-lisp/cconv-tests.el | 152 ------------------------- 3 files changed, 6 insertions(+), 220 deletions(-) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index fb871a9267e..ccb96d169d5 100644 --- 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 b5914745381..8a09c545914 100644 --- 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 a3bc690541d..edb746cdecf 100644 --- 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 -- 2.39.5