From: Alex Vong <alexvong1995@gmail.com>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: Michael Heerdegen <michael_heerdegen@web.de>, 24171@debbugs.gnu.org
Subject: bug#24171: 25.1; Bytecode returns nil instead of expected closure
Date: Mon, 08 Aug 2016 18:38:53 +0800 [thread overview]
Message-ID: <87twevmtoi.fsf@gmail.com> (raw)
In-Reply-To: <jwva8goowef.fsf-monnier+emacsbugs@gnu.org> (Stefan Monnier's message of "Sun, 07 Aug 2016 22:04:15 -0400")
Hi,
Stefan Monnier <monnier@iro.umontreal.ca> writes:
> 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?
>
Yes, this fixes the original problem.
(https://lists.gnu.org/archive/html/help-gnu-emacs/2016-08/msg00038.html)
The test is performed on master branch with patch applied.
> 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.
>
I have no problem with this.
>
> 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
Thanks,
Alex
next prev parent reply other threads:[~2016-08-08 10:38 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
2016-08-08 10:38 ` Alex Vong [this message]
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=87twevmtoi.fsf@gmail.com \
--to=alexvong1995@gmail.com \
--cc=24171@debbugs.gnu.org \
--cc=michael_heerdegen@web.de \
--cc=monnier@iro.umontreal.ca \
/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).