procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix closure-conversion of shadowed captured lambda-lifted vars

Browse source 
Lambda-lifted variables (ones passed explicitly to lambda-lifted
functions) that are also captured in an outer closure and shadowed
were renamed incorrectly (bug#51982).

Reported by Paul Pogonyshev.

* lisp/emacs-lisp/cconv.el (cconv--lifted-arg): New.
(cconv-convert): Provide correct definiens for the closed-over
variable.
* 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.
This commit is contained in:
Mattias Engdegård 2021-11-22 16:56:38 +01:00
parent 6a60bd475d
commit 45252ad8f9
3 changed files with 220 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

31
lisp/emacs-lisp/cconv.el
View file

@ -304,6 +304,25 @@ 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.
@ -428,10 +447,11 @@ 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 ((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 +469,13 @@ 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, 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)