diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 1de5409f7ee..aadb498609a 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -243,17 +243,20 @@ The name is made by appending a number to PREFIX, default \"T\"." (defvar cl--bind-enquote) ;Non-nil if &cl-quote was in the formal arglist! (defvar cl--bind-lets) (defvar cl--bind-forms) -(defun cl--slet (bindings body) +(defun cl--slet (bindings body &optional nowarn) "Like `cl--slet*' but for \"parallel let\"." - (let ((dyn nil)) ;Is there a var declared as dynbound among the bindings? + (let ((dyns nil)) ;Vars declared as dynbound among the bindings? ;; `seq-some' lead to bootstrap problems. (dolist (binding bindings) - (if (macroexp--dynamic-variable-p (car binding)) (setq dyn t))) + (when (macroexp--dynamic-variable-p (car binding)) + (push (car binding) dyns))) (cond - (dyn - `(funcall (lambda (,@(mapcar #'car bindings)) - ,@(macroexp-unprogn body)) - ,@(mapcar #'cadr bindings))) + (dyns + (let ((form `(funcall (lambda (,@(mapcar #'car bindings)) + ,@(macroexp-unprogn body)) + ,@(mapcar #'cadr bindings)))) + (if (not nowarn) form + `(with-suppressed-warnings ((lexical ,@dyns)) ,form)))) ((null (cdr bindings)) (macroexp-let* bindings body)) (t `(let ,bindings ,@(macroexp-unprogn body)))))) @@ -2920,7 +2923,7 @@ The function's arguments should be treated as immutable. (if (and whole (not (cl--safe-expr-p (macroexp-progn argvs)))) whole ;; Function arguments are unconditionally statically scoped (bug#47552). - (cl--slet (cl-mapcar #'list argns argvs) body))) + (cl--slet (cl-mapcar #'list argns argvs) body 'nowarn))) ;;; Structures. @@ -3012,6 +3015,7 @@ To see the documentation for a defined struct type, use (defsym (if cl--struct-inline 'cl-defsubst 'defun)) (forms nil) (docstring (if (stringp (car descs)) (pop descs))) + (dynbound-slotnames '()) pred-form pred-check) ;; Can't use `cl-check-type' yet. (unless (cl--struct-name-p name) @@ -3131,6 +3135,8 @@ To see the documentation for a defined struct type, use (while descp (let* ((desc (pop descp)) (slot (pop desc))) + (when (macroexp--dynamic-variable-p slot) + (push slot dynbound-slotnames)) (if (memq slot '(cl-tag-slot cl-skip-slot)) (progn (push nil slots) @@ -3261,7 +3267,10 @@ To see the documentation for a defined struct type, use ;; forms)) `(progn (defvar ,tag-symbol) - ,@(nreverse forms) + ,@(if (null dynbound-slotnames) + (nreverse forms) + `((with-suppressed-warnings ((lexical . ,dynbound-slotnames)) + ,@(nreverse forms)))) :autoload-end ;; Call cl-struct-define during compilation as well, so that ;; a subsequent cl-defstruct in the same file can correctly include this