Package: emacs;
Reported by: Michael Heerdegen <michael_heerdegen <at> web.de>
Date: Sat, 6 Aug 2016 23:23:02 UTC
Severity: normal
Found in version 25.1
Done: Stefan Monnier <monnier <at> iro.umontreal.ca>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Stefan Monnier <monnier <at> iro.umontreal.ca> To: Michael Heerdegen <michael_heerdegen <at> web.de> Cc: 24171 <at> debbugs.gnu.org, Alex Vong <alexvong1995 <at> gmail.com> Subject: bug#24171: 25.1; Bytecode returns nil instead of expected closure Date: Sun, 07 Aug 2016 22:04:15 -0400
You can test the problem with:
M-: (cconv-closure-convert '(let ((x 1)) (let ((x 2) (f (function (lambda (y) (+ y x))))) (funcall f x))))
where you'll see that the lambda-lifting used by cconv.el is too naive
and uses `x' to refer to the outer variable without noticing that that
variable is shadowed by the inner `x'.
The patch below should fix it and is the best I can come up with so far.
Can you confirm that it fixes the original problem?
The bug was filed against 25.1, so I have (very lightly) tested the
patch against the emacs-25 branch, but since this bug dates back to
Emacs-24.1, I think there's no hurry to fix it.
IOW I intend to install it into master. Please holler if you think it
deserves to be on emacs-25.
Stefan
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 50b1fe3..2d68066 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -253,6 +253,32 @@ Returns a form where all lambdas don't have any free variables."
`(internal-make-closure
,args ,envector ,docstring . ,body-new)))))
+(defun cconv--remap-llv (new-env var closedsym)
+ ;; In a case such as:
+ ;; (let* ((fun (lambda (x) (+ x y))) (y 1)) (funcall fun 1))
+ ;; A naive lambda-lifting would return
+ ;; (let* ((fun (lambda (y x) (+ x y))) (y 1)) (funcall fun y 1))
+ ;; Where the external `y' is mistakenly captured by the inner one.
+ ;; So when we detect that case, we rewrite it to:
+ ;; (let* ((closed-y y) (fun (lambda (y x) (+ x y))) (y 1))
+ ;; (funcall fun closed-y 1))
+ ;; We do that even if there's no `funcall' that uses `fun' in the scope
+ ;; where `y' is shadowed by another variable because, to treat
+ ;; this case better, we'd need to traverse the tree one more time to
+ ;; collect this data, and I think that it's not worth it.
+(mapcar (lambda (mapping)
+ (if (not (eq (cadr mapping) 'apply-partially))
+ mapping
+ (cl-assert (eq (car mapping) (nth 2 mapping)))
+ `(,(car mapping)
+ apply-partially
+ ,(car mapping)
+ ,@(mapcar (lambda (arg)
+ (if (eq var arg)
+ closedsym arg))
+ (nthcdr 3 mapping)))))
+ new-env))
+
(defun cconv-convert (form env extend)
;; This function actually rewrites the tree.
"Return FORM with all its lambdas changed so they are closed.
@@ -350,34 +376,13 @@ places where they originally did not directly appear."
(if (assq var new-env) (push `(,var) new-env))
(cconv-convert value env extend)))))
- ;; The piece of code below letbinds free variables of a λ-lifted
- ;; function if they are redefined in this let, example:
- ;; (let* ((fun (lambda (x) (+ x y))) (y 1)) (funcall fun 1))
- ;; Here we can not pass y as parameter because it is redefined.
- ;; So we add a (closed-y y) declaration. We do that even if the
- ;; function is not used inside this let(*). The reason why we
- ;; ignore this case is that we can't "look forward" to see if the
- ;; function is called there or not. To treat this case better we'd
- ;; need to traverse the tree one more time to collect this data, and
- ;; I think that it's not worth it.
- (when (memq var new-extend)
- (let ((closedsym
- (make-symbol (concat "closed-" (symbol-name var)))))
- (setq new-env
- (mapcar (lambda (mapping)
- (if (not (eq (cadr mapping) 'apply-partially))
- mapping
- (cl-assert (eq (car mapping) (nth 2 mapping)))
- `(,(car mapping)
- apply-partially
- ,(car mapping)
- ,@(mapcar (lambda (arg)
- (if (eq var arg)
- closedsym arg))
- (nthcdr 3 mapping)))))
- new-env))
- (setq new-extend (remq var new-extend))
- (push closedsym new-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 ((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)))
;; We push the element after redefined free variables are
@@ -390,6 +395,21 @@ places where they originally did not directly appear."
(setq extend new-extend))
)) ; end of dolist over binders
+ (when (not (eq letsym 'let*))
+ ;; We can't do the cconv--remap-llv at the same place for let and
+ ;; let* because in the case of `let', the shadowing may occur
+ ;; 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.
+ (let* ((var (car-safe binder))
+ (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)))))
+
`(,letsym ,(nreverse binders-new)
. ,(mapcar (lambda (form)
(cconv-convert
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.