Skip to content

Commit

Permalink
Revert "Fix closure-conversion of shadowed captured lambda-lifted vars"
Browse files Browse the repository at this point in the history 
This reverts commit 3ec8c8b.

It was committed to a stable branch without prior discussion;
see bug#53071.
  • Loading branch information
@mattiase
mattiase committed Jan 12, 2022
1 parent a1ac6bd commit 22ddd2b
Show file tree
Hide file tree
Showing 3 changed files with 6 additions and 220 deletions.
31 changes: 6 additions & 25 deletions lisp/emacs-lisp/cconv.el
View file
Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand All @@ -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)
Expand Down
43 changes: 0 additions & 43 deletions test/lisp/emacs-lisp/bytecomp-tests.el
View file
Expand Up @@ -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.")

Expand Down
152 changes: 0 additions & 152 deletions test/lisp/emacs-lisp/cconv-tests.el
View file
Expand Up @@ -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

0 comments on commit 22ddd2b

Please sign in to comment.