From c244d4af57deb96ce399c70c2781c54e14e1f0bd Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Sep 2022 16:36:16 -0400 Subject: [PATCH] cconv.el: Fix interactive closure bug#51695 Make cconv.el detect when a closure's interactive form needs to capture variables from the context and tweak the code accordingly if so. * lisp/emacs-lisp/cconv.el (cconv--interactive-form-funs): New var. (cconv-convert): Handle the case where the interactive form captures vars from the surrounding context. Remove left over handling of `declare` which was already removed from the cconv-analyze` phase. (cconv-analyze-form): Adjust analysis of interactive forms accordingly. * lisp/emacs-lisp/oclosure.el (cconv--interactive-helper): New type and function. * lisp/simple.el (function-documentation, oclosure-interactive-form): Add methods for it. * test/lisp/emacs-lisp/cconv-tests.el (cconv-tests-interactive-closure-bug51695): New test. --- lisp/emacs-lisp/cconv.el | 51 ++++++++++++++++++++--------- lisp/emacs-lisp/oclosure.el | 15 +++++++++ lisp/simple.el | 6 ++++ test/lisp/emacs-lisp/cconv-tests.el | 10 ++++++ 4 files changed, 67 insertions(+), 15 deletions(-) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 7f95fa94fa1..23d0f121948 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -137,6 +137,11 @@ is less than this number.") ;; Alist associating to each function body the list of its free variables. ) +(defvar cconv--interactive-form-funs + ;; Table used to hold the functions we create internally for + ;; interactive forms. + (make-hash-table :test #'eq :weakness 'key)) + ;;;###autoload (defun cconv-closure-convert (form) "Main entry point for closure conversion. @@ -503,9 +508,23 @@ places where they originally did not directly appear." cond-forms))) (`(function (lambda ,args . ,body) . ,_) - (let ((docstring (if (eq :documentation (car-safe (car body))) - (cconv-convert (cadr (pop body)) env extend)))) - (cconv--convert-function args body env form docstring))) + (let* ((docstring (if (eq :documentation (car-safe (car body))) + (cconv-convert (cadr (pop body)) env extend))) + (bf (if (stringp (car body)) (cdr body) body)) + (if (when (eq 'interactive (car-safe (car bf))) + (gethash form cconv--interactive-form-funs))) + (cif (when if (cconv-convert if env extend))) + (_ (pcase cif + (`#'(lambda () ,form) (setf (cadr (car bf)) form) (setq cif nil)) + ('nil nil) + ;; The interactive form needs special treatment, so the form + ;; inside the `interactive' won't be used any further. + (_ (setf (cadr (car bf)) nil)))) + (cf (cconv--convert-function args body env form docstring))) + (if (not cif) + ;; Normal case, the interactive form needs no special treatment. + cf + `(cconv--interactive-helper ,cf ,cif)))) (`(internal-make-closure . ,_) (byte-compile-report-error @@ -589,12 +608,12 @@ places where they originally did not directly appear." (cconv-convert arg env extend)) (cons fun args))))))) - (`(interactive . ,forms) - `(,(car form) . ,(mapcar (lambda (form) - (cconv-convert form nil nil)) - forms))) + ;; The form (if any) is converted beforehand as part of the `lambda' case. + (`(interactive . ,_) form) - (`(declare . ,_) form) ;The args don't contain code. + ;; `declare' should now be macro-expanded away (and if they're not, we're + ;; in trouble because they *can* contain code nowadays). + ;; (`(declare . ,_) form) ;The args don't contain code. (`(oclosure--fix-type (ignore . ,vars) ,exp) (dolist (var vars) @@ -739,6 +758,13 @@ This function does not return anything but instead fills the (`(function (lambda ,vrs . ,body-forms)) (when (eq :documentation (car-safe (car body-forms))) (cconv-analyze-form (cadr (pop body-forms)) env)) + (let ((bf (if (stringp (car body-forms)) (cdr body-forms) body-forms))) + (when (eq 'interactive (car-safe (car bf))) + (let ((if (cadr (car bf)))) + (unless (macroexp-const-p if) ;Optimize this common case. + (let ((f `#'(lambda () ,if))) + (setf (gethash form cconv--interactive-form-funs) f) + (cconv-analyze-form f env)))))) (cconv--analyze-function vrs body-forms env form)) (`(setq ,var ,expr) @@ -803,13 +829,8 @@ This function does not return anything but instead fills the (cconv-analyze-form fun env))) (dolist (form args) (cconv-analyze-form form env))) - (`(interactive . ,forms) - ;; These appear within the function body but they don't have access - ;; to the function's arguments. - ;; We could extend this to allow interactive specs to refer to - ;; variables in the function's enclosing environment, but it doesn't - ;; seem worth the trouble. - (dolist (form forms) (cconv-analyze-form form nil))) + ;; The form (if any) is converted beforehand as part of the `lambda' case. + (`(interactive . ,_) nil) ;; `declare' should now be macro-expanded away (and if they're not, we're ;; in trouble because they *can* contain code nowadays). diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index 9775e8cc656..c77ac151d77 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -557,6 +557,21 @@ This has 2 uses: (oclosure-define (save-some-buffers-function (:predicate save-some-buffers-function--p))) +;; This OClosure type is used internally by `cconv.el' to handle +;; the case where we need to build a closure whose `interactive' spec +;; captures variables from the context. +;; It arguably belongs with `cconv.el' but is needed at runtime, +;; so we placed it here. +(oclosure-define (cconv--interactive-helper) fun if) +(defun cconv--interactive-helper (fun if) + "Add interactive \"form\" IF to FUN. +Returns a new command that otherwise behaves like FUN. +IF should actually not be a form but a function of no arguments." + (oclosure-lambda (cconv--interactive-helper (fun fun) (if if)) + (&rest args) + (apply (if (called-interactively-p 'any) + #'funcall-interactively #'funcall) + fun args))) (provide 'oclosure) ;;; oclosure.el ends here diff --git a/lisp/simple.el b/lisp/simple.el index aed1547b15b..10a610e0c64 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2653,6 +2653,9 @@ function as needed." (cl-defmethod function-documentation ((function accessor)) (oclosure--accessor-docstring function)) ;; FIXME: η-reduce! +(cl-defmethod function-documentation ((f cconv--interactive-helper)) + (function-documentation (cconv--interactive-helper--fun f))) + ;; This should be in `oclosure.el' but that file is loaded before `cl-generic'. (cl-defgeneric oclosure-interactive-form (_function) "Return the interactive form of FUNCTION or nil if none. @@ -2664,6 +2667,9 @@ instead." ;; (interactive-form function) nil) +(cl-defmethod oclosure-interactive-form ((f cconv--interactive-helper)) + `(interactive (funcall ',(cconv--interactive-helper--if f)))) + (defun command-execute (cmd &optional record-flag keys special) ;; BEWARE: Called directly from the C code. "Execute CMD as an editor command. diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el index 9904c6a969c..37470f863f3 100644 --- a/test/lisp/emacs-lisp/cconv-tests.el +++ b/test/lisp/emacs-lisp/cconv-tests.el @@ -347,5 +347,15 @@ (list x (funcall g closed-x) (funcall h closed-x)))))))) ) +(ert-deftest cconv-tests-interactive-closure-bug51695 () + (let ((f (let ((d 51695)) + (lambda (data) + (interactive (progn (setq d (1+ d)) (list d))) + (list (called-interactively-p 'any) data))))) + (should (equal (list (call-interactively f) + (funcall f 51695) + (call-interactively f)) + '((t 51696) (nil 51695) (t 51697)))))) + (provide 'cconv-tests) ;;; cconv-tests.el ends here -- 2.39.2