Subject: bug#30872: incorrect byte-compile of closure called from local funcalled function

From: Noam Postavsky <[email-masked]>
Date: Mon, 11 Jun 2018 08:36:25 -0400

tags 30872 + patch
quit

Stefan Monnier <[email-masked]> writes:

> Looks sane, thank you.  Even better would be to try and share this code
> rather than duplicate it.  Please try and add some comment in the code,
> tho: it's rather dry (and yes, I know I'm largely to blame for it).

It seemed pretty okay to me; I was confused by the

    (if (assq arg env) (push `(,arg) env))

for a bit, so I added a mention of the nil case to the cconv-convert
docstring.

> Also don't forget to add a corresponding testcase.

Right, here it is.  Should this go to emacs-26?  It looks fairly safe to
me, but since I'm new to this code, I don't want to put too much weight
on my assessment.

>From 7458c4dc8f49f3a2e1d35eb0eda4da5b1c832487 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <[email-masked]>
Date: Thu, 7 Jun 2018 19:58:47 -0400
Subject: [PATCH] Don't forget to analyse args of lambda lifted functions
 (Bug#30872)

* lisp/emacs-lisp/cconv.el (cconv--convert-funcbody): New function.
(cconv--convert-function): Extracted from here.
(cconv-convert): Also use it here, in the lambda lifted case, so that
mutated args are properly accounted for.
* test/lisp/emacs-lisp/cconv-tests.el: New test.
---
 lisp/emacs-lisp/cconv.el            | 55 +++++++++++++++++++++----------------
 test/lisp/emacs-lisp/cconv-tests.el | 40 +++++++++++++++++++++++++++
 2 files changed, 71 insertions(+), 24 deletions(-)
 create mode 100644 test/lisp/emacs-lisp/cconv-tests.el

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 02fe794467..ff4e59ef1b 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -206,7 +206,6 @@ cconv--convert-function
   (cl-assert (equal body (caar cconv-freevars-alist)))
   (let* ((fvs (cdr (pop cconv-freevars-alist)))
          (body-new '())
-         (letbind '())
          (envector ())
          (i 0)
          (new-env ()))
@@ -227,25 +226,8 @@ cconv--convert-function
     (setq envector (nreverse envector))
     (setq new-env (nreverse new-env))
 
-    (dolist (arg args)
-      (if (not (member (cons (list arg) parentform) cconv-captured+mutated))
-          (if (assq arg new-env) (push `(,arg) new-env))
-        (push `(,arg . (car-safe ,arg)) new-env)
-        (push `(,arg (list ,arg)) letbind)))
-
-    (setq body-new (mapcar (lambda (form)
-                             (cconv-convert form new-env nil))
-                           body))
-
-    (when letbind
-      (let ((special-forms '()))
-        ;; Keep special forms at the beginning of the body.
-        (while (or (stringp (car body-new)) ;docstring.
-                   (memq (car-safe (car body-new)) '(interactive declare)))
-          (push (pop body-new) special-forms))
-        (setq body-new
-              `(,@(nreverse special-forms) (let ,letbind . ,body-new)))))
-
+    (setq body-new (cconv--convert-funcbody
+                     args body new-env parentform))
     (cond
      ((not (or envector docstring))     ;If no freevars - do nothing.
       `(function (lambda ,args . ,body-new)))
@@ -279,6 +261,30 @@ cconv--remap-llv
                           (nthcdr 3 mapping)))))
           new-env))
 
+(defun cconv--convert-funcbody (funargs funcbody env parentform)
+  "Run `cconv-convert' on FUNCBODY, the forms of a lambda expression.
+PARENTFORM is the form containing the lambda expression.  ENV is a
+lexical environment (same format as for `cconv-convert'), not
+including FUNARGS, the function's argument list.  Return a list
+of converted forms."
+  (let ((letbind ()))
+    (dolist (arg funargs)
+      (if (not (member (cons (list arg) parentform) cconv-captured+mutated))
+          (if (assq arg env) (push `(,arg . nil) env))
+        (push `(,arg . (car-safe ,arg)) env)
+        (push `(,arg (list ,arg)) letbind)))
+    (setq funcbody (mapcar (lambda (form)
+                             (cconv-convert form env nil))
+                           funcbody))
+    (if letbind
+        (let ((special-forms '()))
+          ;; Keep special forms at the beginning of the body.
+          (while (or (stringp (car funcbody)) ;docstring.
+                     (memq (car-safe (car funcbody)) '(interactive declare)))
+            (push (pop funcbody) special-forms))
+          `(,@(nreverse special-forms) (let ,letbind . ,funcbody)))
+      funcbody)))
+
 (defun cconv-convert (form env extend)
   ;; This function actually rewrites the tree.
   "Return FORM with all its lambdas changed so they are closed.
@@ -292,6 +298,9 @@ cconv-convert
     environment's Nth slot.
  (VAR . (apply-partially F ARG1 ARG2 ..)): VAR has been λ-lifted and takes
     additional arguments ARGs.
+ (VAR . nil): VAR is accessed normally.  This is the same as VAR
+    being absent from ENV, but an explicit nil entry is useful
+    for shadowing VAR for a specific scope.
 EXTEND is a list of variables which might need to be accessed even from places
 where they are shadowed, because some part of ENV causes them to be used at
 places where they originally did not directly appear."
@@ -360,10 +369,8 @@ cconv-convert
                                 (not (memq fv funargs)))
                            (push `(,fv . (car-safe ,fv)) funcbody-env)))
                      `(function (lambda ,funcvars .
-                                  ,(mapcar (lambda (form)
-                                             (cconv-convert
-                                              form funcbody-env nil))
-                                           funcbody)))))
+                                  ,(cconv--convert-funcbody
+                                    funargs funcbody funcbody-env value)))))
 
                   ;; Check if it needs to be turned into a "ref-cell".
                   ((member (cons binder form) cconv-captured+mutated)
diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el
new file mode 100644
index 0000000000..d14847ce45
--- /dev/null
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -0,0 +1,40 @@
+;;; cconv-tests.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+(require 'ert)
+
+(ert-deftest cconv-convert-lambda-lifted ()
+  "Bug#30872."
+  (should
+   (equal (funcall
+           (byte-compile
+            '#'(lambda (handle-fun arg)
+                 (let* ((subfun
+                         #'(lambda (params)
+                             (ignore handle-fun)
+                             (funcall #'(lambda () (setq params 42)))
+                             params)))
+                   (funcall subfun arg))))
+           nil 99)
+          42)))
+
+(provide 'cconv-tests)
+;; cconv-tests.el ends here.
-- 
2.11.0