* bug#58592: [PATCH] (Ffunction): Make interpreted closures safe for space
@ 2022-10-17 21:12 Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-10-25 18:27 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 2+ messages in thread
From: Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-10-17 21:12 UTC (permalink / raw)
To: 58592
[-- Attachment #1: Type: text/plain, Size: 624 bytes --]
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'
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Ffunction-Make-interpreted-closures-safe-for-space.patch --]
[-- Type: text/patch, Size: 18422 bytes --]
From 01919211ed84c0459d87b52c0488e07457194b2b Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
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
^ permalink raw reply related [flat|nested] 2+ messages in thread
* bug#58592: [PATCH] (Ffunction): Make interpreted closures safe for space
2022-10-17 21:12 bug#58592: [PATCH] (Ffunction): Make interpreted closures safe for space Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2022-10-25 18:27 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 0 replies; 2+ messages in thread
From: Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-10-25 18:27 UTC (permalink / raw)
To: 58592-done
Stefan Monnier [2022-10-17 17:12:42] wrote:
> See the commit message for explanations.
Pushed to `master`,
Stefan
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2022-10-25 18:27 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-10-17 21:12 bug#58592: [PATCH] (Ffunction): Make interpreted closures safe for space Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-10-25 18:27 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.