summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/cconv.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp/cconv.el')
-rw-r--r--lisp/emacs-lisp/cconv.el51
1 files changed, 37 insertions, 14 deletions
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 5f37db3fe9b..ad9d8ab0a51 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -236,9 +236,9 @@ Returns a form where all lambdas don't have any free variables."
(not (intern-soft var))
(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)
- (if suggestions (concat "\n " suggestions) "")))))
+ (format-message "Unused lexical %s `%S'%s"
+ varkind (bare-symbol var)
+ (if suggestions (concat "\n " suggestions) "")))))
(define-inline cconv--var-classification (binder form)
(inline-quote
@@ -463,7 +463,7 @@ places where they originally did not directly appear."
; first element is lambda expression
(`(,(and `(lambda . ,_) fun) . ,args)
;; FIXME: it's silly to create a closure just to call it.
- ;; Running byte-optimize-form earlier will resolve this.
+ ;; Running byte-optimize-form earlier would resolve this.
`(funcall
,(cconv-convert `(function ,fun) env extend)
,@(mapcar (lambda (form)
@@ -483,10 +483,13 @@ places where they originally did not directly appear."
(bf (if (stringp (car body)) (cdr body) body))
(if (when (eq 'interactive (car-safe (car bf)))
(gethash form cconv--interactive-form-funs)))
+ (wrapped (pcase if (`#'(lambda (&rest _cconv--dummy) .,_) t) (_ nil)))
(cif (when if (cconv-convert if env extend)))
(_ (pcase cif
- (`#'(lambda () ,form) (setf (cadr (car bf)) form) (setq cif nil))
('nil nil)
+ (`#',f
+ (setf (cadr (car bf)) (if wrapped (nth 2 f) cif))
+ (setq cif nil))
;; The interactive form needs special treatment, so the form
;; inside the `interactive' won't be used any further.
(_ (setf (cadr (car bf)) nil))))
@@ -494,7 +497,8 @@ places where they originally did not directly appear."
(if (not cif)
;; Normal case, the interactive form needs no special treatment.
cf
- `(cconv--interactive-helper ,cf ,cif))))
+ `(cconv--interactive-helper
+ ,cf ,(if wrapped cif `(list 'quote ,cif))))))
(`(internal-make-closure . ,_)
(byte-compile-report-error
@@ -742,7 +746,8 @@ This function does not return anything but instead fills the
(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)))
+ (let ((f (if (eq 'function (car-safe if)) if
+ `#'(lambda (&rest _cconv--dummy) ,if))))
(setf (gethash form cconv--interactive-form-funs) f)
(cconv-analyze-form f env))))))
(cconv--analyze-function vrs body-forms env form))
@@ -829,10 +834,13 @@ This function does not return anything but instead fills the
(define-obsolete-function-alias 'cconv-analyse-form #'cconv-analyze-form "25.1")
(defun cconv-fv (form lexvars dynvars)
- "Return the list of free variables in FORM.
-LEXVARS is the list of statically scoped vars in the context
-and DYNVARS is the list of dynamically scoped vars in the context.
-Returns a pair (LEXV . DYNV) of those vars actually used by FORM."
+ "Return the free variables used in FORM.
+FORM is usually a function #\\='(lambda ...), but may be any valid
+form. LEXVARS is a list of symbols, each of which is lexically
+bound in FORM's context. DYNVARS is a list of symbols, each of
+which is dynamically bound in FORM's context.
+Returns a cons (LEXV . DYNV), the car and cdr being lists of the
+lexically and dynamically bound symbols actually used by FORM."
(let* ((fun
;; Wrap FORM into a function because the analysis code we
;; have only computes freevars for functions.
@@ -870,11 +878,26 @@ Returns a pair (LEXV . DYNV) of those vars actually used by FORM."
(cons fvs dyns)))))
(defun cconv-make-interpreted-closure (fun env)
+ "Make a closure for the interpreter.
+This is intended to be called at runtime by the ELisp interpreter (when
+the code has not been compiled).
+FUN is the closure's source code, must be a lambda form.
+ENV is the runtime representation of the lexical environment,
+i.e. a list whose elements can be either plain symbols (which indicate
+that this symbol should use dynamic scoping) or pairs (SYMBOL . VALUE)
+for the lexical bindings."
(cl-assert (eq (car-safe fun) 'lambda))
(let ((lexvars (delq nil (mapcar #'car-safe env))))
- (if (null lexvars)
- ;; The lexical environment is empty, so there's no need to
- ;; look for free variables.
+ (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,
+ ;; so there's no need to look for free variables.
+ ;; Attempting to replace ,(cdr fun) by a macroexpanded version
+ ;; causes bootstrap to fail.
`(closure ,env . ,(cdr fun))
;; We could try and cache the result of the macroexpansion and
;; `cconv-fv' analysis. Not sure it's worth the trouble.