From: Stefan Monnier <monnier@iro.umontreal.ca>
To: Michael Heerdegen <michael_heerdegen@web.de>
Cc: 24171@debbugs.gnu.org, Alex Vong <alexvong1995@gmail.com>
Subject: bug#24171: 25.1; Bytecode returns nil instead of expected closure
Date: Sun, 07 Aug 2016 22:04:15 -0400 [thread overview]
Message-ID: <jwva8goowef.fsf-monnier+emacsbugs@gnu.org> (raw)
In-Reply-To: <877fbtqyhp.fsf@web.de> (Michael Heerdegen's message of "Sun, 07 Aug 2016 01:16:50 +0200")
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
next prev parent reply other threads:[~2016-08-08 2:04 UTC|newest]
Thread overview: 11+ messages / expand[flat|nested] mbox.gz Atom feed top
2016-08-06 23:16 bug#24171: 25.1; Bytecode returns nil instead of expected closure Michael Heerdegen
2016-08-07 9:01 ` Andreas Schwab
2016-08-07 9:30 ` Clément Pit--Claudel
2016-08-07 11:24 ` Andreas Schwab
2016-08-07 22:57 ` Michael Heerdegen
2016-08-07 14:44 ` Stefan Monnier
2016-08-08 2:04 ` Stefan Monnier [this message]
2016-08-08 10:38 ` Alex Vong
2016-08-09 17:05 ` Stefan Monnier
2016-08-09 3:26 ` Michael Heerdegen
2016-08-09 3:48 ` Michael Heerdegen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=jwva8goowef.fsf-monnier+emacsbugs@gnu.org \
--to=monnier@iro.umontreal.ca \
--cc=24171@debbugs.gnu.org \
--cc=alexvong1995@gmail.com \
--cc=michael_heerdegen@web.de \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).