summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMattias Engdegård <mattiase@acm.org>2022-01-12 19:47:39 +0100
committerMattias Engdegård <mattiase@acm.org>2022-01-12 20:23:09 +0100
commit22ddd2ba13ae002a23f41ae543e211a06a85ad8f (patch)
tree7b2320dbb1c55d9a2f50717a2b53c66d32da5aca
parenta1ac6bd47e11659ed750e5819208294ed6ec36c2 (diff)
downloademacs-22ddd2ba13ae002a23f41ae543e211a06a85ad8f.tar.gz
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.
-rw-r--r--lisp/emacs-lisp/cconv.el31
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el43
-rw-r--r--test/lisp/emacs-lisp/cconv-tests.el152
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