From unknown Tue Jun 17 01:49:18 2025 X-Loop: help-debbugs@gnu.org Subject: bug#58592: [PATCH] (Ffunction): Make interpreted closures safe for space Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 17 Oct 2022 21:14:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 58592 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: 58592@debbugs.gnu.org X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.16660411852596 (code B ref -1); Mon, 17 Oct 2022 21:14:02 +0000 Received: (at submit) by debbugs.gnu.org; 17 Oct 2022 21:13:05 +0000 Received: from localhost ([127.0.0.1]:50249 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1okXQ0-0000fl-5d for submit@debbugs.gnu.org; Mon, 17 Oct 2022 17:13:05 -0400 Received: from lists.gnu.org ([209.51.188.17]:34204) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1okXPx-0000fK-3K for submit@debbugs.gnu.org; Mon, 17 Oct 2022 17:13:02 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:45432) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1okXPt-00020J-Il for bug-gnu-emacs@gnu.org; Mon, 17 Oct 2022 17:13:00 -0400 Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:37486) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1okXPp-0002ar-Lg for bug-gnu-emacs@gnu.org; Mon, 17 Oct 2022 17:12:57 -0400 Received: from pmg1.iro.umontreal.ca (localhost.localdomain [127.0.0.1]) by pmg1.iro.umontreal.ca (Proxmox) with ESMTP id 199B110013B for ; Mon, 17 Oct 2022 17:12:52 -0400 (EDT) Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg1.iro.umontreal.ca (Proxmox) with ESMTP id F38B4100084 for ; Mon, 17 Oct 2022 17:12:48 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1666041169; bh=J3BsZAkg2giWINW2TbllX1VwbBGwpnUW5DKVwYXRPqE=; h=From:To:Subject:Date:From; b=YBRNRVqt+hH+ELmnQYfJ3dMcHI1aiuD37qNz9gxmWWT35tIJuOAGlIwhf1P4ea5br 8t+1eixeZROgX4S3imBqXPVAAsSnJbgra1JExGFC7zaqLURWde/4lb1DXd0fyO8bKf TZO/yhcG89IdkQsNOAn5hh0EbEKlEPJGnBmoSS9cNBw3GvUPyCk3t8ICsbs4Iisrsc tmG1JqoCcaFk7HQqivVIUCd3FWBTa24pmp0plGdG+0PrODpK/6b9eMb+3OCramvUId QjEcaMd8dmc4gdSdgnqN4kDvjfSjbm79/Lyo9SgTp/SVjT1loQNSawwZVdFcMQjZd+ GiSIxbqmkHf/w== Received: from alfajor (modemcable137.21-80-70.mc.videotron.ca [70.80.21.137]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id CB71E1203FE for ; Mon, 17 Oct 2022 17:12:48 -0400 (EDT) From: Stefan Monnier Date: Mon, 17 Oct 2022 17:12:42 -0400 Message-ID: MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-SPAM-INFO: Spam detection results: 0 ALL_TRUSTED -1 Passed through trusted hosts only via SMTP AWL 0.092 Adjusted score from AWL reputation of From: address BAYES_00 -1.9 Bayes spam probability is 0 to 1% DKIM_SIGNED 0.1 Message has a DKIM or DK signature, not necessarily valid DKIM_VALID -0.1 Message has at least one valid DKIM or DK signature DKIM_VALID_AU -0.1 Message has a valid DKIM or DK signature from author's domain X-SPAM-LEVEL: Received-SPF: pass client-ip=132.204.25.50; envelope-from=monnier@iro.umontreal.ca; helo=mailscanner.iro.umontreal.ca X-Spam_score_int: -42 X-Spam_score: -4.3 X-Spam_bar: ---- X-Spam_report: (-4.3 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, RCVD_IN_DNSWL_MED=-2.3, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: -1.3 (-) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.3 (--) --=-=-= Content-Type: text/plain Tags: patch See the commit message for explanations. In GNU Emacs 29.0.50 (build 1, x86_64-pc-linux-gnux32, GTK+ Version 3.24.34, cairo version 1.16.0) of 2022-09-30 built on alfajor Repository revision: 4e10f8f784909da61311b4dcdb3b673a7b886c41 Repository branch: work Windowing system distributor 'The X.Org Foundation', version 11.0.12101003 System Description: Debian GNU/Linux bookworm/sid Configured using: 'configure -C --enable-checking --enable-check-lisp-object-type --with-modules --with-cairo --with-tiff=ifavailable 'CFLAGS=-Wall -g3 -Og -Wno-pointer-sign' PKG_CONFIG_PATH=/home/monnier/lib/pkgconfig' --=-=-= Content-Type: text/patch Content-Disposition: attachment; filename=0001-Ffunction-Make-interpreted-closures-safe-for-space.patch >From 01919211ed84c0459d87b52c0488e07457194b2b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 17 Oct 2022 17:11:40 -0400 Subject: [PATCH] (Ffunction): Make interpreted closures safe for space Interpreted closures currently just grab a reference to the complete lexical environment, so (lambda (x) (+ x y)) can end up looking like (closure ((foo ...) (y 7) (bar ...) ...) (x) (+ x y)) where the foo/bar/... bindings are not only useless but can prevent the GC from collecting that memory (i.e. it's a representation that is not "safe for space") and it can also make that closure "unwritable" (or more specifically, it can cause the closure's print representation to be u`read`able). Compiled closures don't suffer from this problem because `cconv.el` actually looks at the code and only stores in the compiled closure those variables which are actually used. So, we fix this discrepancy by letting the existing code in `cconv.el` tell `Ffunction` which variables are actually used by the body of the function such that it can filter out the irrelevant elements and return a closure of the form: (closure ((y 7)) (x) (+ x y)) * lisp/loadup.el: Preload `cconv` and set `internal-filter-closure-env-function` once we have a usable `cconv-fv`. * lisp/emacs-lisp/bytecomp.el (byte-compile-preprocess): Adjust to new calling convention of `cconv-closure-convert`. (byte-compile-not-lexical-var-p): Delete function, moved to `cconv.el`. (byte-compile-bind): Use `cconv--not-lexical-var-p`. * lisp/emacs-lisp/cconv.el (cconv--dynbound-variables): New var. (cconv-closure-convert): New arg `dynbound-vars` (cconv--warn-unused-msg): Remove special case for `ignored`, so we don't get confused when a function uses an argument called `ignored`, e.g. holding a list of things that it should ignore. (cconv--not-lexical-var-p): New function, moved from `bytecomp.el`. Don't special case keywords and `nil` and `t` since they are already `special-variable-p`. (cconv--analyze-function): Use `cconv--not-lexical-var-p`. (cconv--dynbindings): New dynbound var. (cconv-analyze-form): Use `cconv--not-lexical-var-p`. Remember in `cconv--dynbindings` the vars for which we used dynamic scoping. (cconv-analyze-form): Use `cconv--dynbound-variables` rather than `byte-compile-bound-variables`. (cconv-fv): New function. * src/eval.c (Fsetq, eval_sub): Remove optimization designed when `lexical-binding == nil` was the common case. (Ffunction): Use `internal-filter-closure-env-function` when available. (eval_sub, Ffuncall): Improve error info for `excessive_lisp_nesting`. (internal-filter-closure-env-function): New defvar. --- lisp/emacs-lisp/bytecomp.el | 11 +--- lisp/emacs-lisp/cconv.el | 116 ++++++++++++++++++++++-------------- lisp/loadup.el | 4 ++ src/eval.c | 27 ++++++--- 4 files changed, 94 insertions(+), 64 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 692a87f6d57..fa201f1345c 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2569,7 +2569,7 @@ byte-compile-preprocess ;; macroexpand-all. ;; (if (memq byte-optimize '(t source)) ;; (setq form (byte-optimize-form form for-effect))) - (cconv-closure-convert form)) + (cconv-closure-convert form byte-compile-bound-variables)) ;; byte-hunk-handlers cannot call this! (defun byte-compile-toplevel-file-form (top-level-form) @@ -4667,13 +4667,6 @@ byte-compile-push-binding-init (byte-compile-form (cadr clause)) (byte-compile-push-constant nil))))) -(defun byte-compile-not-lexical-var-p (var) - (or (not (symbolp var)) - (special-variable-p var) - (memq var byte-compile-bound-variables) - (memq var '(nil t)) - (keywordp var))) - (defun byte-compile-bind (var init-lexenv) "Emit byte-codes to bind VAR and update `byte-compile--lexical-environment'. INIT-LEXENV should be a lexical-environment alist describing the @@ -4682,7 +4675,7 @@ byte-compile-bind ;; The mix of lexical and dynamic bindings mean that we may have to ;; juggle things on the stack, to move them to TOS for ;; dynamic binding. - (if (and lexical-binding (not (byte-compile-not-lexical-var-p var))) + (if (not (cconv--not-lexical-var-p var byte-compile-bound-variables)) ;; VAR is a simple stack-allocated lexical variable. (progn (push (assq var init-lexenv) byte-compile--lexical-environment) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 23d0f121948..e598e395281 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -64,20 +64,12 @@ ;; ;;; Code: -;; PROBLEM cases found during conversion to lexical binding. -;; We should try and detect and warn about those cases, even -;; for lexical-binding==nil to help prepare the migration. -;; - Uses of run-hooks, and friends. -;; - Cases where we want to apply the same code to different vars depending on -;; some test. These sometimes use a (let ((foo (if bar 'a 'b))) -;; ... (symbol-value foo) ... (set foo ...)). - ;; TODO: (not just for cconv but also for the lexbind changes in general) ;; - let (e)debug find the value of lexical variables from the stack. ;; - make eval-region do the eval-sexp-add-defvars dance. ;; - byte-optimize-form should be applied before cconv. ;; OTOH, the warnings emitted by cconv-analyze need to come before optimize -;; since afterwards they can because obnoxious (warnings about an "unused +;; since afterwards they can become obnoxious (warnings about an "unused ;; variable" should not be emitted when the variable use has simply been ;; optimized away). ;; - let macros specify that some let-bindings come from the same source, @@ -87,33 +79,9 @@ ;; - canonize code in macro-expand so we don't have to handle (let (var) body) ;; and other oddities. ;; - new byte codes for unwind-protect so that closures aren't needed at all. -;; - a reference to a var that is known statically to always hold a constant -;; should be turned into a byte-constant rather than a byte-stack-ref. -;; Hmm... right, that's called constant propagation and could be done here, -;; but when that constant is a function, we have to be careful to make sure -;; the bytecomp only compiles it once. ;; - Since we know here when a variable is not mutated, we could pass that ;; info to the byte-compiler, e.g. by using a new `immutable-let'. ;; - call known non-escaping functions with `goto' rather than `call'. -;; - optimize mapc to a dolist loop. - -;; (defmacro dlet (binders &rest body) -;; ;; Works in both lexical and non-lexical mode. -;; (declare (indent 1) (debug let)) -;; `(progn -;; ,@(mapcar (lambda (binder) -;; `(defvar ,(if (consp binder) (car binder) binder))) -;; binders) -;; (let ,binders ,@body))) - -;; (defmacro llet (binders &rest body) -;; ;; Only works in lexical-binding mode. -;; `(funcall -;; (lambda ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder)) -;; binders) -;; ,@body) -;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder))) -;; binders))) (eval-when-compile (require 'cl-lib)) @@ -142,13 +110,19 @@ cconv--interactive-form-funs ;; interactive forms. (make-hash-table :test #'eq :weakness 'key)) +(defvar cconv--dynbound-variables nil + "List of variables known to be dynamically bound.") + ;;;###autoload -(defun cconv-closure-convert (form) +(defun cconv-closure-convert (form &optional dynbound-vars) "Main entry point for closure conversion. FORM is a piece of Elisp code after macroexpansion. +DYNBOUND-VARS is a list of symbols that should be considered as +using dynamic scoping. Returns a form where all lambdas don't have any free variables." - (let ((cconv-freevars-alist '()) + (let ((cconv--dynbound-variables dynbound-vars) + (cconv-freevars-alist '()) (cconv-var-classification '())) ;; Analyze form - fill these variables with new information. (cconv-analyze-form form '()) @@ -262,9 +236,7 @@ cconv--warn-unused-msg ;; it is often non-trivial for the programmer to avoid such ;; unused vars. (not (intern-soft var)) - (eq ?_ (aref (symbol-name var) 0)) - ;; As a special exception, ignore "ignored". - (eq var 'ignored)) + (eq ?_ (aref (symbol-name var) 0))) (let ((suggestions (help-uni-confusable-suggestions (symbol-name var)))) (format "Unused lexical %s `%S'%s" varkind (bare-symbol var) @@ -342,7 +314,7 @@ cconv-convert where they are shadowed, because some part of ENV causes them to be used at places where they originally did not directly appear." (cl-assert (not (delq nil (mapcar (lambda (mapping) - (if (eq (cadr mapping) 'apply-partially) + (if (eq (cadr mapping) #'apply-partially) (cconv--set-diff (cdr (cddr mapping)) extend))) env)))) @@ -634,6 +606,12 @@ cconv-convert (defvar byte-compile-lexical-variables) +(defun cconv--not-lexical-var-p (var dynbounds) + (or (not lexical-binding) + (not (symbolp var)) + (special-variable-p var) + (memq var dynbounds))) + (defun cconv--analyze-use (vardata form varkind) "Analyze the use of a variable. VARDATA should be (BINDER READ MUTATED CAPTURED CALLED). @@ -677,7 +655,7 @@ cconv--analyze-function ;; outside of it. (envcopy (mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env)) - (byte-compile-bound-variables byte-compile-bound-variables) + (cconv--dynbound-variables cconv--dynbound-variables) (newenv envcopy)) ;; Push it before recursing, so cconv-freevars-alist contains entries in ;; the order they'll be used by closure-convert-rec. @@ -685,7 +663,7 @@ cconv--analyze-function (when lexical-binding (dolist (arg args) (cond - ((byte-compile-not-lexical-var-p arg) + ((cconv--not-lexical-var-p arg cconv--dynbound-variables) (byte-compile-warn-x arg "Lexical argument shadows the dynamic variable %S" @@ -715,6 +693,8 @@ cconv--analyze-function (setf (nth 3 (car env)) t)) (setq env (cdr env) envcopy (cdr envcopy)))))) +(defvar cconv--dynbindings) + (defun cconv-analyze-form (form env) "Find mutated variables and variables captured by closure. Analyze lambdas if they are suitable for lambda lifting. @@ -730,7 +710,7 @@ cconv-analyze-form (let ((orig-env env) (newvars nil) (var nil) - (byte-compile-bound-variables byte-compile-bound-variables) + (cconv--dynbound-variables cconv--dynbound-variables) (value nil)) (dolist (binder binders) (if (not (consp binder)) @@ -743,7 +723,9 @@ cconv-analyze-form (cconv-analyze-form value (if (eq letsym 'let*) env orig-env))) - (unless (or (byte-compile-not-lexical-var-p var) (not lexical-binding)) + (if (cconv--not-lexical-var-p var cconv--dynbound-variables) + (when (boundp 'cconv--dynbindings) + (push var cconv--dynbindings)) (cl-pushnew var byte-compile-lexical-variables) (let ((varstruct (list var nil nil nil nil))) (push (cons binder (cdr varstruct)) newvars) @@ -797,7 +779,8 @@ cconv-analyze-form (cconv-analyze-form protected-form env) (unless lexical-binding (setq var nil)) - (when (and var (symbolp var) (byte-compile-not-lexical-var-p var)) + (when (and var (symbolp var) + (cconv--not-lexical-var-p var cconv--dynbound-variables)) (byte-compile-warn-x var "Lexical variable shadows the dynamic variable %S" var)) (let* ((varstruct (list var nil nil nil nil))) @@ -813,9 +796,9 @@ cconv-analyze-form (cconv-analyze-form form env) (cconv--analyze-function () body env form)) - (`(defvar ,var) (push var byte-compile-bound-variables)) + (`(defvar ,var) (push var cconv--dynbound-variables)) (`(,(or 'defconst 'defvar) ,var ,value . ,_) - (push var byte-compile-bound-variables) + (push var cconv--dynbound-variables) (cconv-analyze-form value env)) (`(,(or 'funcall 'apply) ,fun . ,args) @@ -847,5 +830,46 @@ cconv-analyze-form (setf (nth 1 dv) t)))))) (define-obsolete-function-alias 'cconv-analyse-form #'cconv-analyze-form "25.1") +(defun cconv-fv (form env &optional no-macroexpand) + "Return the list of free variables in FORM. +ENV is the lexical environment from which the variables can be taken. +It should be a list of pairs of the form (VAR . VAL). +The return value is a list of those (VAR . VAL) bindings, +in the same order as they appear in ENV. +If NO-MACROEXPAND is non-nil, we do not macro-expand FORM, +which means that the result may be incorrect if there are non-expanded +macro calls in FORM." + (let* ((fun `#'(lambda () ,form)) + ;; Make dummy bindings to avoid warnings about the var being + ;; left uninitialized. + (analysis-env + (delq nil (mapcar (lambda (b) (if (consp b) + (list (car b) nil nil nil nil))) + env))) + (cconv--dynbound-variables + (delq nil (mapcar (lambda (b) (if (symbolp b) b)) env))) + (byte-compile-lexical-variables nil) + (cconv--dynbindings nil) + (cconv-freevars-alist '()) + (cconv-var-classification '())) + (if (null analysis-env) + ;; The lexical environment is empty, so there's no need to + ;; look for free variables. + env + (let* ((fun (if no-macroexpand fun + (macroexpand-all fun macroexpand-all-environment))) + (body (cddr (cadr fun)))) + ;; Analyze form - fill these variables with new information. + (cconv-analyze-form fun analysis-env) + (setq cconv-freevars-alist (nreverse cconv-freevars-alist)) + (cl-assert (equal (if (eq :documentation (car-safe (car body))) + (cdr body) body) + (caar cconv-freevars-alist))) + (let ((fvs (nreverse (cdar cconv-freevars-alist))) + (dyns (mapcar (lambda (var) (car (memq var env))) + (delete-dups cconv--dynbindings)))) + (nconc (mapcar (lambda (fv) (assq fv env)) fvs) + (delq nil dyns))))))) + (provide 'cconv) ;;; cconv.el ends here diff --git a/lisp/loadup.el b/lisp/loadup.el index e940a32100c..63806ae4565 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -366,6 +366,10 @@ (load "emacs-lisp/shorthands") (load "emacs-lisp/eldoc") +(load "emacs-lisp/cconv") +(when (and (byte-code-function-p (symbol-function 'cconv-fv)) + (byte-code-function-p (symbol-function 'macroexpand-all))) + (setq internal-filter-closure-env-function #'cconv-fv)) (load "cus-start") ;Late to reduce customize-rogue (needs loaddefs.el anyway) (if (not (eq system-type 'ms-dos)) (load "tooltip")) diff --git a/src/eval.c b/src/eval.c index 8810136c041..d2cab006d11 100644 --- a/src/eval.c +++ b/src/eval.c @@ -484,8 +484,7 @@ DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0, /* Like for eval_sub, we do not check declared_special here since it's been done when let-binding. */ Lisp_Object lex_binding - = ((!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ - && SYMBOLP (sym)) + = (SYMBOLP (sym) ? Fassq (sym, Vinternal_interpreter_environment) : Qnil); if (!NILP (lex_binding)) @@ -551,8 +550,15 @@ DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0, CHECK_STRING (docstring); cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr)))); } - return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, - cdr)); + Lisp_Object env + = NILP (Vinternal_filter_closure_env_function) + ? Vinternal_interpreter_environment + /* FIXME: This macroexpands the body, so we should use the resulting + macroexpanded code! */ + : call2 (Vinternal_filter_closure_env_function, + Fcons (Qprogn, CONSP (cdr) ? XCDR (cdr) : cdr), + Vinternal_interpreter_environment); + return Fcons (Qclosure, Fcons (env, cdr)); } else /* Simply quote the argument. */ @@ -2374,9 +2380,7 @@ eval_sub (Lisp_Object form) We do not pay attention to the declared_special flag here, since we already did that when let-binding the variable. */ Lisp_Object lex_binding - = (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ - ? Fassq (form, Vinternal_interpreter_environment) - : Qnil); + = Fassq (form, Vinternal_interpreter_environment); return !NILP (lex_binding) ? XCDR (lex_binding) : Fsymbol_value (form); } @@ -2392,7 +2396,7 @@ eval_sub (Lisp_Object form) if (max_lisp_eval_depth < 100) max_lisp_eval_depth = 100; if (lisp_eval_depth > max_lisp_eval_depth) - xsignal0 (Qexcessive_lisp_nesting); + xsignal1 (Qexcessive_lisp_nesting, make_fixnum (lisp_eval_depth)); } Lisp_Object original_fun = XCAR (form); @@ -2966,7 +2970,7 @@ DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0, if (max_lisp_eval_depth < 100) max_lisp_eval_depth = 100; if (lisp_eval_depth > max_lisp_eval_depth) - xsignal0 (Qexcessive_lisp_nesting); + xsignal1 (Qexcessive_lisp_nesting, make_fixnum (lisp_eval_depth)); } count = record_in_backtrace (args[0], &args[1], nargs - 1); @@ -4357,6 +4361,11 @@ syms_of_eval (void) (Just imagine if someone makes it buffer-local). */ Funintern (Qinternal_interpreter_environment, Qnil); + DEFVAR_LISP ("internal-filter-closure-env-function", + Vinternal_filter_closure_env_function, + doc: /* Function to filter the env when constructing a closure. */); + Vinternal_filter_closure_env_function = Qnil; + Vrun_hooks = intern_c_string ("run-hooks"); staticpro (&Vrun_hooks); -- 2.35.1 --=-=-=-- From unknown Tue Jun 17 01:49:18 2025 MIME-Version: 1.0 X-Mailer: MIME-tools 5.505 (Entity 5.505) X-Loop: help-debbugs@gnu.org From: help-debbugs@gnu.org (GNU bug Tracking System) To: Stefan Monnier Subject: bug#58592: closed (Re: bug#58592: [PATCH] (Ffunction): Make interpreted closures safe for space) Message-ID: References: X-Gnu-PR-Message: they-closed 58592 X-Gnu-PR-Package: emacs X-Gnu-PR-Keywords: patch Reply-To: 58592@debbugs.gnu.org Date: Tue, 25 Oct 2022 18:28:01 +0000 Content-Type: multipart/mixed; boundary="----------=_1666722481-1272-1" This is a multi-part message in MIME format... ------------=_1666722481-1272-1 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset="utf-8" Your bug report #58592: [PATCH] (Ffunction): Make interpreted closures safe for space which was filed against the emacs package, has been closed. The explanation is attached below, along with your original report. If you require more details, please reply to 58592@debbugs.gnu.org. --=20 58592: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=3D58592 GNU Bug Tracking System Contact help-debbugs@gnu.org with problems ------------=_1666722481-1272-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit Received: (at 58592-done) by debbugs.gnu.org; 25 Oct 2022 18:27:21 +0000 Received: from localhost ([127.0.0.1]:52240 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1onOe1-0000JZ-7s for submit@debbugs.gnu.org; Tue, 25 Oct 2022 14:27:21 -0400 Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:42072) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1onOdz-0000JI-7S for 58592-done@debbugs.gnu.org; Tue, 25 Oct 2022 14:27:20 -0400 Received: from pmg3.iro.umontreal.ca (localhost [127.0.0.1]) by pmg3.iro.umontreal.ca (Proxmox) with ESMTP id 678CC44257C; Tue, 25 Oct 2022 14:27:13 -0400 (EDT) Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg3.iro.umontreal.ca (Proxmox) with ESMTP id 3181744251A; Tue, 25 Oct 2022 14:27:12 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1666722432; bh=3KwZNI5u0KfCnGdQAcYGepPZg2M0RAB+BEgv4vQLra8=; h=From:To:Subject:In-Reply-To:References:Date:From; b=Vb3y5B/ePMh7u/avGwQE34nSGHpBz90LyEcvjMzIFtbBsdqEkwFPEy7xqYM4zSqdh rFm7gZyiMfHUeo2MtULKEZlZoUPNh6UPMWJHzdn1uXpx+JALagXJjrC2pH/rKeKs8g cZ1er4dZkpGo7y4WlMF0bigXRESB+y8iLcAHy/zZSJVCPmf+oR20zgQg3zLcXX8Mo2 s+ijZg8hiqD/STvyxuJaNb+FnjVZqV+uUpcsQ+197WVni8avf1AxlHVGl3xykTt+yx HTHT/eeDT6F9HETCNCyH9UBJuMST6onbrgqA44H+96QI6IUMISIGlTH+7OT2Us0gJd tAPU3YbGJqa1w== Received: from alfajor (unknown [45.44.229.252]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id 16800120F57; Tue, 25 Oct 2022 14:27:12 -0400 (EDT) From: Stefan Monnier To: 58592-done@debbugs.gnu.org Subject: Re: bug#58592: [PATCH] (Ffunction): Make interpreted closures safe for space In-Reply-To: (Stefan Monnier's message of "Mon, 17 Oct 2022 17:12:42 -0400") Message-ID: References: Date: Tue, 25 Oct 2022 14:27:11 -0400 User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-SPAM-INFO: Spam detection results: 0 ALL_TRUSTED -1 Passed through trusted hosts only via SMTP AWL -0.476 Adjusted score from AWL reputation of From: address BAYES_00 -1.9 Bayes spam probability is 0 to 1% DKIM_SIGNED 0.1 Message has a DKIM or DK signature, not necessarily valid DKIM_VALID -0.1 Message has at least one valid DKIM or DK signature DKIM_VALID_AU -0.1 Message has a valid DKIM or DK signature from author's domain X-SPAM-LEVEL: X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 58592-done X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Stefan Monnier [2022-10-17 17:12:42] wrote: > See the commit message for explanations. Pushed to `master`, Stefan ------------=_1666722481-1272-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit Received: (at submit) by debbugs.gnu.org; 17 Oct 2022 21:13:05 +0000 Received: from localhost ([127.0.0.1]:50249 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1okXQ0-0000fl-5d for submit@debbugs.gnu.org; Mon, 17 Oct 2022 17:13:05 -0400 Received: from lists.gnu.org ([209.51.188.17]:34204) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1okXPx-0000fK-3K for submit@debbugs.gnu.org; Mon, 17 Oct 2022 17:13:02 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:45432) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1okXPt-00020J-Il for bug-gnu-emacs@gnu.org; Mon, 17 Oct 2022 17:13:00 -0400 Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:37486) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1okXPp-0002ar-Lg for bug-gnu-emacs@gnu.org; Mon, 17 Oct 2022 17:12:57 -0400 Received: from pmg1.iro.umontreal.ca (localhost.localdomain [127.0.0.1]) by pmg1.iro.umontreal.ca (Proxmox) with ESMTP id 199B110013B for ; Mon, 17 Oct 2022 17:12:52 -0400 (EDT) Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg1.iro.umontreal.ca (Proxmox) with ESMTP id F38B4100084 for ; Mon, 17 Oct 2022 17:12:48 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1666041169; bh=J3BsZAkg2giWINW2TbllX1VwbBGwpnUW5DKVwYXRPqE=; h=From:To:Subject:Date:From; b=YBRNRVqt+hH+ELmnQYfJ3dMcHI1aiuD37qNz9gxmWWT35tIJuOAGlIwhf1P4ea5br 8t+1eixeZROgX4S3imBqXPVAAsSnJbgra1JExGFC7zaqLURWde/4lb1DXd0fyO8bKf TZO/yhcG89IdkQsNOAn5hh0EbEKlEPJGnBmoSS9cNBw3GvUPyCk3t8ICsbs4Iisrsc tmG1JqoCcaFk7HQqivVIUCd3FWBTa24pmp0plGdG+0PrODpK/6b9eMb+3OCramvUId QjEcaMd8dmc4gdSdgnqN4kDvjfSjbm79/Lyo9SgTp/SVjT1loQNSawwZVdFcMQjZd+ GiSIxbqmkHf/w== Received: from alfajor (modemcable137.21-80-70.mc.videotron.ca [70.80.21.137]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id CB71E1203FE for ; Mon, 17 Oct 2022 17:12:48 -0400 (EDT) From: Stefan Monnier To: bug-gnu-emacs@gnu.org Subject: [PATCH] (Ffunction): Make interpreted closures safe for space Date: Mon, 17 Oct 2022 17:12:42 -0400 Message-ID: MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-SPAM-INFO: Spam detection results: 0 ALL_TRUSTED -1 Passed through trusted hosts only via SMTP AWL 0.092 Adjusted score from AWL reputation of From: address BAYES_00 -1.9 Bayes spam probability is 0 to 1% DKIM_SIGNED 0.1 Message has a DKIM or DK signature, not necessarily valid DKIM_VALID -0.1 Message has at least one valid DKIM or DK signature DKIM_VALID_AU -0.1 Message has a valid DKIM or DK signature from author's domain X-SPAM-LEVEL: Received-SPF: pass client-ip=132.204.25.50; envelope-from=monnier@iro.umontreal.ca; helo=mailscanner.iro.umontreal.ca X-Spam_score_int: -42 X-Spam_score: -4.3 X-Spam_bar: ---- X-Spam_report: (-4.3 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, RCVD_IN_DNSWL_MED=-2.3, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: -1.3 (-) X-Debbugs-Envelope-To: submit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.3 (--) --=-=-= Content-Type: text/plain Tags: patch See the commit message for explanations. In GNU Emacs 29.0.50 (build 1, x86_64-pc-linux-gnux32, GTK+ Version 3.24.34, cairo version 1.16.0) of 2022-09-30 built on alfajor Repository revision: 4e10f8f784909da61311b4dcdb3b673a7b886c41 Repository branch: work Windowing system distributor 'The X.Org Foundation', version 11.0.12101003 System Description: Debian GNU/Linux bookworm/sid Configured using: 'configure -C --enable-checking --enable-check-lisp-object-type --with-modules --with-cairo --with-tiff=ifavailable 'CFLAGS=-Wall -g3 -Og -Wno-pointer-sign' PKG_CONFIG_PATH=/home/monnier/lib/pkgconfig' --=-=-= Content-Type: text/patch Content-Disposition: attachment; filename=0001-Ffunction-Make-interpreted-closures-safe-for-space.patch >From 01919211ed84c0459d87b52c0488e07457194b2b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 17 Oct 2022 17:11:40 -0400 Subject: [PATCH] (Ffunction): Make interpreted closures safe for space Interpreted closures currently just grab a reference to the complete lexical environment, so (lambda (x) (+ x y)) can end up looking like (closure ((foo ...) (y 7) (bar ...) ...) (x) (+ x y)) where the foo/bar/... bindings are not only useless but can prevent the GC from collecting that memory (i.e. it's a representation that is not "safe for space") and it can also make that closure "unwritable" (or more specifically, it can cause the closure's print representation to be u`read`able). Compiled closures don't suffer from this problem because `cconv.el` actually looks at the code and only stores in the compiled closure those variables which are actually used. So, we fix this discrepancy by letting the existing code in `cconv.el` tell `Ffunction` which variables are actually used by the body of the function such that it can filter out the irrelevant elements and return a closure of the form: (closure ((y 7)) (x) (+ x y)) * lisp/loadup.el: Preload `cconv` and set `internal-filter-closure-env-function` once we have a usable `cconv-fv`. * lisp/emacs-lisp/bytecomp.el (byte-compile-preprocess): Adjust to new calling convention of `cconv-closure-convert`. (byte-compile-not-lexical-var-p): Delete function, moved to `cconv.el`. (byte-compile-bind): Use `cconv--not-lexical-var-p`. * lisp/emacs-lisp/cconv.el (cconv--dynbound-variables): New var. (cconv-closure-convert): New arg `dynbound-vars` (cconv--warn-unused-msg): Remove special case for `ignored`, so we don't get confused when a function uses an argument called `ignored`, e.g. holding a list of things that it should ignore. (cconv--not-lexical-var-p): New function, moved from `bytecomp.el`. Don't special case keywords and `nil` and `t` since they are already `special-variable-p`. (cconv--analyze-function): Use `cconv--not-lexical-var-p`. (cconv--dynbindings): New dynbound var. (cconv-analyze-form): Use `cconv--not-lexical-var-p`. Remember in `cconv--dynbindings` the vars for which we used dynamic scoping. (cconv-analyze-form): Use `cconv--dynbound-variables` rather than `byte-compile-bound-variables`. (cconv-fv): New function. * src/eval.c (Fsetq, eval_sub): Remove optimization designed when `lexical-binding == nil` was the common case. (Ffunction): Use `internal-filter-closure-env-function` when available. (eval_sub, Ffuncall): Improve error info for `excessive_lisp_nesting`. (internal-filter-closure-env-function): New defvar. --- lisp/emacs-lisp/bytecomp.el | 11 +--- lisp/emacs-lisp/cconv.el | 116 ++++++++++++++++++++++-------------- lisp/loadup.el | 4 ++ src/eval.c | 27 ++++++--- 4 files changed, 94 insertions(+), 64 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 692a87f6d57..fa201f1345c 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2569,7 +2569,7 @@ byte-compile-preprocess ;; macroexpand-all. ;; (if (memq byte-optimize '(t source)) ;; (setq form (byte-optimize-form form for-effect))) - (cconv-closure-convert form)) + (cconv-closure-convert form byte-compile-bound-variables)) ;; byte-hunk-handlers cannot call this! (defun byte-compile-toplevel-file-form (top-level-form) @@ -4667,13 +4667,6 @@ byte-compile-push-binding-init (byte-compile-form (cadr clause)) (byte-compile-push-constant nil))))) -(defun byte-compile-not-lexical-var-p (var) - (or (not (symbolp var)) - (special-variable-p var) - (memq var byte-compile-bound-variables) - (memq var '(nil t)) - (keywordp var))) - (defun byte-compile-bind (var init-lexenv) "Emit byte-codes to bind VAR and update `byte-compile--lexical-environment'. INIT-LEXENV should be a lexical-environment alist describing the @@ -4682,7 +4675,7 @@ byte-compile-bind ;; The mix of lexical and dynamic bindings mean that we may have to ;; juggle things on the stack, to move them to TOS for ;; dynamic binding. - (if (and lexical-binding (not (byte-compile-not-lexical-var-p var))) + (if (not (cconv--not-lexical-var-p var byte-compile-bound-variables)) ;; VAR is a simple stack-allocated lexical variable. (progn (push (assq var init-lexenv) byte-compile--lexical-environment) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 23d0f121948..e598e395281 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -64,20 +64,12 @@ ;; ;;; Code: -;; PROBLEM cases found during conversion to lexical binding. -;; We should try and detect and warn about those cases, even -;; for lexical-binding==nil to help prepare the migration. -;; - Uses of run-hooks, and friends. -;; - Cases where we want to apply the same code to different vars depending on -;; some test. These sometimes use a (let ((foo (if bar 'a 'b))) -;; ... (symbol-value foo) ... (set foo ...)). - ;; TODO: (not just for cconv but also for the lexbind changes in general) ;; - let (e)debug find the value of lexical variables from the stack. ;; - make eval-region do the eval-sexp-add-defvars dance. ;; - byte-optimize-form should be applied before cconv. ;; OTOH, the warnings emitted by cconv-analyze need to come before optimize -;; since afterwards they can because obnoxious (warnings about an "unused +;; since afterwards they can become obnoxious (warnings about an "unused ;; variable" should not be emitted when the variable use has simply been ;; optimized away). ;; - let macros specify that some let-bindings come from the same source, @@ -87,33 +79,9 @@ ;; - canonize code in macro-expand so we don't have to handle (let (var) body) ;; and other oddities. ;; - new byte codes for unwind-protect so that closures aren't needed at all. -;; - a reference to a var that is known statically to always hold a constant -;; should be turned into a byte-constant rather than a byte-stack-ref. -;; Hmm... right, that's called constant propagation and could be done here, -;; but when that constant is a function, we have to be careful to make sure -;; the bytecomp only compiles it once. ;; - Since we know here when a variable is not mutated, we could pass that ;; info to the byte-compiler, e.g. by using a new `immutable-let'. ;; - call known non-escaping functions with `goto' rather than `call'. -;; - optimize mapc to a dolist loop. - -;; (defmacro dlet (binders &rest body) -;; ;; Works in both lexical and non-lexical mode. -;; (declare (indent 1) (debug let)) -;; `(progn -;; ,@(mapcar (lambda (binder) -;; `(defvar ,(if (consp binder) (car binder) binder))) -;; binders) -;; (let ,binders ,@body))) - -;; (defmacro llet (binders &rest body) -;; ;; Only works in lexical-binding mode. -;; `(funcall -;; (lambda ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder)) -;; binders) -;; ,@body) -;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder))) -;; binders))) (eval-when-compile (require 'cl-lib)) @@ -142,13 +110,19 @@ cconv--interactive-form-funs ;; interactive forms. (make-hash-table :test #'eq :weakness 'key)) +(defvar cconv--dynbound-variables nil + "List of variables known to be dynamically bound.") + ;;;###autoload -(defun cconv-closure-convert (form) +(defun cconv-closure-convert (form &optional dynbound-vars) "Main entry point for closure conversion. FORM is a piece of Elisp code after macroexpansion. +DYNBOUND-VARS is a list of symbols that should be considered as +using dynamic scoping. Returns a form where all lambdas don't have any free variables." - (let ((cconv-freevars-alist '()) + (let ((cconv--dynbound-variables dynbound-vars) + (cconv-freevars-alist '()) (cconv-var-classification '())) ;; Analyze form - fill these variables with new information. (cconv-analyze-form form '()) @@ -262,9 +236,7 @@ cconv--warn-unused-msg ;; it is often non-trivial for the programmer to avoid such ;; unused vars. (not (intern-soft var)) - (eq ?_ (aref (symbol-name var) 0)) - ;; As a special exception, ignore "ignored". - (eq var 'ignored)) + (eq ?_ (aref (symbol-name var) 0))) (let ((suggestions (help-uni-confusable-suggestions (symbol-name var)))) (format "Unused lexical %s `%S'%s" varkind (bare-symbol var) @@ -342,7 +314,7 @@ cconv-convert where they are shadowed, because some part of ENV causes them to be used at places where they originally did not directly appear." (cl-assert (not (delq nil (mapcar (lambda (mapping) - (if (eq (cadr mapping) 'apply-partially) + (if (eq (cadr mapping) #'apply-partially) (cconv--set-diff (cdr (cddr mapping)) extend))) env)))) @@ -634,6 +606,12 @@ cconv-convert (defvar byte-compile-lexical-variables) +(defun cconv--not-lexical-var-p (var dynbounds) + (or (not lexical-binding) + (not (symbolp var)) + (special-variable-p var) + (memq var dynbounds))) + (defun cconv--analyze-use (vardata form varkind) "Analyze the use of a variable. VARDATA should be (BINDER READ MUTATED CAPTURED CALLED). @@ -677,7 +655,7 @@ cconv--analyze-function ;; outside of it. (envcopy (mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env)) - (byte-compile-bound-variables byte-compile-bound-variables) + (cconv--dynbound-variables cconv--dynbound-variables) (newenv envcopy)) ;; Push it before recursing, so cconv-freevars-alist contains entries in ;; the order they'll be used by closure-convert-rec. @@ -685,7 +663,7 @@ cconv--analyze-function (when lexical-binding (dolist (arg args) (cond - ((byte-compile-not-lexical-var-p arg) + ((cconv--not-lexical-var-p arg cconv--dynbound-variables) (byte-compile-warn-x arg "Lexical argument shadows the dynamic variable %S" @@ -715,6 +693,8 @@ cconv--analyze-function (setf (nth 3 (car env)) t)) (setq env (cdr env) envcopy (cdr envcopy)))))) +(defvar cconv--dynbindings) + (defun cconv-analyze-form (form env) "Find mutated variables and variables captured by closure. Analyze lambdas if they are suitable for lambda lifting. @@ -730,7 +710,7 @@ cconv-analyze-form (let ((orig-env env) (newvars nil) (var nil) - (byte-compile-bound-variables byte-compile-bound-variables) + (cconv--dynbound-variables cconv--dynbound-variables) (value nil)) (dolist (binder binders) (if (not (consp binder)) @@ -743,7 +723,9 @@ cconv-analyze-form (cconv-analyze-form value (if (eq letsym 'let*) env orig-env))) - (unless (or (byte-compile-not-lexical-var-p var) (not lexical-binding)) + (if (cconv--not-lexical-var-p var cconv--dynbound-variables) + (when (boundp 'cconv--dynbindings) + (push var cconv--dynbindings)) (cl-pushnew var byte-compile-lexical-variables) (let ((varstruct (list var nil nil nil nil))) (push (cons binder (cdr varstruct)) newvars) @@ -797,7 +779,8 @@ cconv-analyze-form (cconv-analyze-form protected-form env) (unless lexical-binding (setq var nil)) - (when (and var (symbolp var) (byte-compile-not-lexical-var-p var)) + (when (and var (symbolp var) + (cconv--not-lexical-var-p var cconv--dynbound-variables)) (byte-compile-warn-x var "Lexical variable shadows the dynamic variable %S" var)) (let* ((varstruct (list var nil nil nil nil))) @@ -813,9 +796,9 @@ cconv-analyze-form (cconv-analyze-form form env) (cconv--analyze-function () body env form)) - (`(defvar ,var) (push var byte-compile-bound-variables)) + (`(defvar ,var) (push var cconv--dynbound-variables)) (`(,(or 'defconst 'defvar) ,var ,value . ,_) - (push var byte-compile-bound-variables) + (push var cconv--dynbound-variables) (cconv-analyze-form value env)) (`(,(or 'funcall 'apply) ,fun . ,args) @@ -847,5 +830,46 @@ cconv-analyze-form (setf (nth 1 dv) t)))))) (define-obsolete-function-alias 'cconv-analyse-form #'cconv-analyze-form "25.1") +(defun cconv-fv (form env &optional no-macroexpand) + "Return the list of free variables in FORM. +ENV is the lexical environment from which the variables can be taken. +It should be a list of pairs of the form (VAR . VAL). +The return value is a list of those (VAR . VAL) bindings, +in the same order as they appear in ENV. +If NO-MACROEXPAND is non-nil, we do not macro-expand FORM, +which means that the result may be incorrect if there are non-expanded +macro calls in FORM." + (let* ((fun `#'(lambda () ,form)) + ;; Make dummy bindings to avoid warnings about the var being + ;; left uninitialized. + (analysis-env + (delq nil (mapcar (lambda (b) (if (consp b) + (list (car b) nil nil nil nil))) + env))) + (cconv--dynbound-variables + (delq nil (mapcar (lambda (b) (if (symbolp b) b)) env))) + (byte-compile-lexical-variables nil) + (cconv--dynbindings nil) + (cconv-freevars-alist '()) + (cconv-var-classification '())) + (if (null analysis-env) + ;; The lexical environment is empty, so there's no need to + ;; look for free variables. + env + (let* ((fun (if no-macroexpand fun + (macroexpand-all fun macroexpand-all-environment))) + (body (cddr (cadr fun)))) + ;; Analyze form - fill these variables with new information. + (cconv-analyze-form fun analysis-env) + (setq cconv-freevars-alist (nreverse cconv-freevars-alist)) + (cl-assert (equal (if (eq :documentation (car-safe (car body))) + (cdr body) body) + (caar cconv-freevars-alist))) + (let ((fvs (nreverse (cdar cconv-freevars-alist))) + (dyns (mapcar (lambda (var) (car (memq var env))) + (delete-dups cconv--dynbindings)))) + (nconc (mapcar (lambda (fv) (assq fv env)) fvs) + (delq nil dyns))))))) + (provide 'cconv) ;;; cconv.el ends here diff --git a/lisp/loadup.el b/lisp/loadup.el index e940a32100c..63806ae4565 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -366,6 +366,10 @@ (load "emacs-lisp/shorthands") (load "emacs-lisp/eldoc") +(load "emacs-lisp/cconv") +(when (and (byte-code-function-p (symbol-function 'cconv-fv)) + (byte-code-function-p (symbol-function 'macroexpand-all))) + (setq internal-filter-closure-env-function #'cconv-fv)) (load "cus-start") ;Late to reduce customize-rogue (needs loaddefs.el anyway) (if (not (eq system-type 'ms-dos)) (load "tooltip")) diff --git a/src/eval.c b/src/eval.c index 8810136c041..d2cab006d11 100644 --- a/src/eval.c +++ b/src/eval.c @@ -484,8 +484,7 @@ DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0, /* Like for eval_sub, we do not check declared_special here since it's been done when let-binding. */ Lisp_Object lex_binding - = ((!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ - && SYMBOLP (sym)) + = (SYMBOLP (sym) ? Fassq (sym, Vinternal_interpreter_environment) : Qnil); if (!NILP (lex_binding)) @@ -551,8 +550,15 @@ DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0, CHECK_STRING (docstring); cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr)))); } - return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, - cdr)); + Lisp_Object env + = NILP (Vinternal_filter_closure_env_function) + ? Vinternal_interpreter_environment + /* FIXME: This macroexpands the body, so we should use the resulting + macroexpanded code! */ + : call2 (Vinternal_filter_closure_env_function, + Fcons (Qprogn, CONSP (cdr) ? XCDR (cdr) : cdr), + Vinternal_interpreter_environment); + return Fcons (Qclosure, Fcons (env, cdr)); } else /* Simply quote the argument. */ @@ -2374,9 +2380,7 @@ eval_sub (Lisp_Object form) We do not pay attention to the declared_special flag here, since we already did that when let-binding the variable. */ Lisp_Object lex_binding - = (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ - ? Fassq (form, Vinternal_interpreter_environment) - : Qnil); + = Fassq (form, Vinternal_interpreter_environment); return !NILP (lex_binding) ? XCDR (lex_binding) : Fsymbol_value (form); } @@ -2392,7 +2396,7 @@ eval_sub (Lisp_Object form) if (max_lisp_eval_depth < 100) max_lisp_eval_depth = 100; if (lisp_eval_depth > max_lisp_eval_depth) - xsignal0 (Qexcessive_lisp_nesting); + xsignal1 (Qexcessive_lisp_nesting, make_fixnum (lisp_eval_depth)); } Lisp_Object original_fun = XCAR (form); @@ -2966,7 +2970,7 @@ DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0, if (max_lisp_eval_depth < 100) max_lisp_eval_depth = 100; if (lisp_eval_depth > max_lisp_eval_depth) - xsignal0 (Qexcessive_lisp_nesting); + xsignal1 (Qexcessive_lisp_nesting, make_fixnum (lisp_eval_depth)); } count = record_in_backtrace (args[0], &args[1], nargs - 1); @@ -4357,6 +4361,11 @@ syms_of_eval (void) (Just imagine if someone makes it buffer-local). */ Funintern (Qinternal_interpreter_environment, Qnil); + DEFVAR_LISP ("internal-filter-closure-env-function", + Vinternal_filter_closure_env_function, + doc: /* Function to filter the env when constructing a closure. */); + Vinternal_filter_closure_env_function = Qnil; + Vrun_hooks = intern_c_string ("run-hooks"); staticpro (&Vrun_hooks); -- 2.35.1 --=-=-=-- ------------=_1666722481-1272-1--