Don't rely on dynamic scoping to fix bug#59213

Rather than look up a dynamically scoped var to decide whether to trim
closures, use an ad-hoc marker on those closures which should not be trimmed.

* lisp/emacs-lisp/cconv.el (cconv-dont-trim-unused-variables): Delete var.
(cconv-make-interpreted-closure): Use a `:closure-dont-trim-context`
markers instead.

* lisp/emacs-lisp/edebug.el (edebug-make-enter-wrapper): Use
`:closure-dont-trim-context` rather than `cconv-dont-trim-unused-variables`.

* lisp/emacs-lisp/testcover.el (testcover-analyze-coverage): Remove
workaround for `cconv-dont-trim-unused-variables`.

* test/lisp/emacs-lisp/cconv-tests.el (cconv-safe-for-space): New test.
This commit is contained in:
Stefan Monnier 2023-02-18 12:56:24 -05:00
parent 2ac8d7e64a
commit 750bc57cbb
4 changed files with 34 additions and 21 deletions

View file

@ -113,10 +113,6 @@ is less than this number.")
(defvar cconv--dynbound-variables nil (defvar cconv--dynbound-variables nil
"List of variables known to be dynamically bound.") "List of variables known to be dynamically bound.")
(defvar cconv-dont-trim-unused-variables nil
"When bound to non-nil, don't remove unused variables from the environment.
This is intended for use by edebug and similar.")
;;;###autoload ;;;###autoload
(defun cconv-closure-convert (form &optional dynbound-vars) (defun cconv-closure-convert (form &optional dynbound-vars)
"Main entry point for closure conversion. "Main entry point for closure conversion.
@ -882,15 +878,22 @@ lexically and dynamically bound symbols actually used by FORM."
(cons fvs dyns))))) (cons fvs dyns)))))
(defun cconv-make-interpreted-closure (fun env) (defun cconv-make-interpreted-closure (fun env)
;; FIXME: I don't know what "This function is evaluated both at
;; compile time and run time" is intended to mean here.
"Make a closure for the interpreter. "Make a closure for the interpreter.
This function is evaluated both at compile time and run time. This function is evaluated both at compile time and run time.
FUN, the closure's function, must be a lambda form. FUN, the closure's function, must be a lambda form.
ENV, the closure's environment, is a mixture of lexical bindings of the form ENV, the closure's environment, is a mixture of lexical bindings of the form
(SYMBOL . VALUE) and symbols which indicate dynamic bindings of those \(SYMBOL . VALUE) and symbols which indicate dynamic bindings of those
symbols." symbols."
(cl-assert (eq (car-safe fun) 'lambda)) (cl-assert (eq (car-safe fun) 'lambda))
(let ((lexvars (delq nil (mapcar #'car-safe env)))) (let ((lexvars (delq nil (mapcar #'car-safe env))))
(if (or cconv-dont-trim-unused-variables (null lexvars)) (if (or (null lexvars)
;; Functions with a `:closure-dont-trim-context' marker
;; should keep their whole context untrimmed (bug#59213).
(and (eq :closure-dont-trim-context (nth 2 fun))
;; Check the function doesn't just return the magic keyword.
(nthcdr 3 fun)))
;; The lexical environment is empty, or needs to be preserved, ;; The lexical environment is empty, or needs to be preserved,
;; so there's no need to look for free variables. ;; so there's no need to look for free variables.
;; Attempting to replace ,(cdr fun) by a macroexpanded version ;; Attempting to replace ,(cdr fun) by a macroexpanded version

View file

@ -1217,16 +1217,18 @@ purpose by adding an entry to this alist, and setting
(setq edebug-old-def-name nil)) (setq edebug-old-def-name nil))
(setq edebug-def-name (setq edebug-def-name
(or edebug-def-name edebug-old-def-name (gensym "edebug-anon"))) (or edebug-def-name edebug-old-def-name (gensym "edebug-anon")))
`(let ((cconv-dont-trim-unused-variables t)) `(edebug-enter
(edebug-enter (quote ,edebug-def-name)
(quote ,edebug-def-name) ,(if edebug-inside-func
,(if edebug-inside-func `(list
`(list ;; Doesn't work with more than one def-body!!
;; Doesn't work with more than one def-body!! ;; But the list will just be reversed.
;; But the list will just be reversed. ,@(nreverse edebug-def-args))
,@(nreverse edebug-def-args)) 'nil)
'nil) ;; Make sure `forms' is not nil so we don't accidentally return
(function (lambda () ,@forms))))) ;; the magic keyword. Mark the closure so we don't throw away
;; unused vars (bug#59213).
#'(lambda () :closure-dont-trim-context ,@(or forms '(nil)))))
(defvar edebug-form-begin-marker) ; the mark for def being instrumented (defvar edebug-form-begin-marker) ; the mark for def being instrumented

View file

@ -442,11 +442,6 @@ or return multiple values."
(let ((testcover-vector (get sym 'edebug-coverage))) (let ((testcover-vector (get sym 'edebug-coverage)))
(testcover-analyze-coverage-progn body))) (testcover-analyze-coverage-progn body)))
(`(let ((cconv-dont-trim-unused-variables t))
(edebug-enter ',sym ,_ (function (lambda nil . ,body))))
(let ((testcover-vector (get sym 'edebug-coverage)))
(testcover-analyze-coverage-progn body)))
(`(edebug-after ,(and before-form (`(edebug-after ,(and before-form
(or `(edebug-before ,before-id) before-id)) (or `(edebug-before ,before-id) before-id))
,after-id ,wrapped-form) ,after-id ,wrapped-form)

View file

@ -364,5 +364,18 @@
(call-interactively f)) (call-interactively f))
'((t 51696) (nil 51695) (t 51697))))))) '((t 51696) (nil 51695) (t 51697)))))))
(ert-deftest cconv-safe-for-space ()
(let* ((magic-string "This-is-a-magic-string")
(safe-p (lambda (x) (not (string-match magic-string (format "%S" x))))))
(should (funcall safe-p (lambda (x) (+ x 1))))
(should (funcall safe-p (eval '(lambda (x) (+ x 1))
`((y . ,magic-string)))))
(should (funcall safe-p (eval '(lambda (x) :closure-dont-trim-context)
`((y . ,magic-string)))))
(should-not (funcall safe-p
(eval '(lambda (x) :closure-dont-trim-context (+ x 1))
`((y . ,magic-string)))))))
(provide 'cconv-tests) (provide 'cconv-tests)
;;; cconv-tests.el ends here ;;; cconv-tests.el ends here