bug#24171: 25.1; Bytecode returns nil instead of expected closure

bug#24171: 25.1; Bytecode returns nil instead of expected closure

[Michael Heerdegen]

Hello,

eval this defun:

(defun test ()
  (let ((my-cool-fun 'dummy))
    (let ((my-cool-fun
           (let ((calculate (lambda () 1)))
             (lambda () (setq my-cool-fun calculate))))
          (return-my-cool-fun (lambda () my-cool-fun)))
      (funcall my-cool-fun)
      (funcall return-my-cool-fun))))

(test) evals to a closure as expected.

Compile the defun and load it.  Then,

  (test) -> nil

which is wrong.

Found in

   https://lists.gnu.org/archive/html/help-gnu-emacs/2016-08/msg00038.html


Thanks,

Michael.



In GNU Emacs 25.1.1 (x86_64-pc-linux-gnu, GTK+ Version 3.20.6)
 of 2016-08-04 built on drachen
Repository revision: 72221f51439d666d54f5d147f00ecdbb3778ab1b
Windowing system distributor 'The X.Org Foundation', version 11.0.11804000
System Description:	Debian GNU/Linux testing (stretch)

Configured features:
XPM JPEG TIFF GIF PNG RSVG IMAGEMAGICK SOUND DBUS GSETTINGS NOTIFY
LIBXML2 FREETYPE XFT ZLIB TOOLKIT_SCROLL_BARS GTK3 X11

bug#24171: 25.1; Bytecode returns nil instead of expected closure

[Andreas Schwab]

Michael Heerdegen <michael_heerdegen@web.de> writes:

> eval this defun:
>
> (defun test ()
>   (let ((my-cool-fun 'dummy))
>     (let ((my-cool-fun
>            (let ((calculate (lambda () 1)))
>              (lambda () (setq my-cool-fun calculate))))
>           (return-my-cool-fun (lambda () my-cool-fun)))
>       (funcall my-cool-fun)
>       (funcall return-my-cool-fun))))
>
> (test) evals to a closure as expected.

ELISP> (test)
*** Eval error ***  Symbol’s value as variable is void: calculate

Andreas.

-- 
Andreas Schwab, schwab@linux-m68k.org
GPG Key fingerprint = 58CA 54C7 6D53 942B 1756  01D3 44D5 214B 8276 4ED5
"And now for something completely different."

bug#24171: 25.1; Bytecode returns nil instead of expected closure

[Clément Pit--Claudel]

[-- Attachment #1.1: Type: text/plain, Size: 688 bytes --]

On 2016-08-07 05:01, Andreas Schwab wrote:
> Michael Heerdegen <michael_heerdegen@web.de> writes:
> 
>> eval this defun:
>>
>> (defun test ()
>>   (let ((my-cool-fun 'dummy))
>>     (let ((my-cool-fun
>>            (let ((calculate (lambda () 1)))
>>              (lambda () (setq my-cool-fun calculate))))
>>           (return-my-cool-fun (lambda () my-cool-fun)))
>>       (funcall my-cool-fun)
>>       (funcall return-my-cool-fun))))
>>
>> (test) evals to a closure as expected.
> 
> ELISP> (test)
> *** Eval error ***  Symbol’s value as variable is void: calculate

I can reproduce this. Andreas, are you missing ;; -*- lexical-binding: t; -*- ?

Clément.


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]

bug#24171: 25.1; Bytecode returns nil instead of expected closure

[Andreas Schwab]

On So, Aug 07 2016, Clément Pit--Claudel <clement.pit@gmail.com> wrote:

> On 2016-08-07 05:01, Andreas Schwab wrote:
>> Michael Heerdegen <michael_heerdegen@web.de> writes:
>> 
>>> eval this defun:
>>>
>>> (defun test ()
>>>   (let ((my-cool-fun 'dummy))
>>>     (let ((my-cool-fun
>>>            (let ((calculate (lambda () 1)))
>>>              (lambda () (setq my-cool-fun calculate))))
>>>           (return-my-cool-fun (lambda () my-cool-fun)))
>>>       (funcall my-cool-fun)
>>>       (funcall return-my-cool-fun))))
>>>
>>> (test) evals to a closure as expected.
>> 
>> ELISP> (test)
>> *** Eval error ***  Symbol’s value as variable is void: calculate
>
> I can reproduce this. Andreas, are you missing ;; -*- lexical-binding: t; -*- ?

I was following the instructions.

Andreas.

-- 
Andreas Schwab, schwab@linux-m68k.org
GPG Key fingerprint = 58CA 54C7 6D53 942B 1756  01D3 44D5 214B 8276 4ED5
"And now for something completely different."

bug#24171: 25.1; Bytecode returns nil instead of expected closure

[Michael Heerdegen]

Andreas Schwab <schwab@linux-m68k.org> writes:

> ELISP> (test)
> *** Eval error ***  Symbol’s value as variable is void: calculate

Eh, sorry, forgot to mention that the recipe needs lexical-binding.


Thanks,

Michael.

bug#24171: 25.1; Bytecode returns nil instead of expected closure

[Stefan Monnier]

> (defun test ()
>   (let ((my-cool-fun 'dummy))
>     (let ((my-cool-fun
>            (let ((calculate (lambda () 1)))
>              (lambda () (setq my-cool-fun calculate))))
>           (return-my-cool-fun (lambda () my-cool-fun)))
>       (funcall my-cool-fun)
>       (funcall return-my-cool-fun))))

Good catch.  It's a bug in cconv.el in the case where it decides to use
lambda-lifting.  It tries to handle such name-capture (search for "(when
(memq var new-extend)" in cconv.el to see where) but doesn't catch the
above case.

Don't have a fix yet.  For the above test case, you can circumvent the
bug by swapping the order of return-my-cool-fun and my-cool-fun in the
let binding.


        Stefan

bug#24171: 25.1; Bytecode returns nil instead of expected closure

[Stefan Monnier]

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

bug#24171: 25.1; Bytecode returns nil instead of expected closure

[Alex Vong]

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

bug#24171: 25.1; Bytecode returns nil instead of expected closure

[Stefan Monnier]

> 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.

Thanks, installed.


        Stefan

bug#24171: 25.1; Bytecode returns nil instead of expected closure

[Michael Heerdegen]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> IOW I intend to install it into master.

master sounds good to me.

But wait, what's this:

(defun test ()
  (let ((x 1))
    (let ((x 2)
          (f (function (lambda (y) (/ y x)))))
      (funcall f x))))

(test) => 2

compile...

(test) ==> 1 ?


Thanks,

Michael.

bug#24171: 25.1; Bytecode returns nil instead of expected closure

[Michael Heerdegen]

Michael Heerdegen <michael_heerdegen@web.de> writes:

> (test) => 2
>
> compile...
>
> (test) ==> 1 ?

That was false alarm, everything is fine, I forgot to enable
lexical-binding or whatever.


Thanks for the quick fix,

Michael.