mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

cl-macs.el: Silence recent new "lexical arg shadows" warnings

Browse source 
* lisp/emacs-lisp/cl-macs.el (cl--slet): Add `nowarn` arg.
(cl--defsubst-expand): Use it.
(cl-defstruct): Silence warnings abour lexical shadowing when a slot's
name happens to be the same as a dynbound var.
This commit is contained in:
Stefan Monnier 2023-06-25 11:38:40 -04:00
parent 0228421e34
commit 4c50af02ab
1 changed files with 18 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

27
lisp/emacs-lisp/cl-macs.el
View file

@ -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-enquote) ;Non-nil if &cl-quote was in the formal arglist!
(defvar cl--bind-lets) (defvar cl--bind-forms) (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\"." "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. ;; `seq-some' lead to bootstrap problems.
(dolist (binding bindings) (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 (cond
(dyn (dyns
`(funcall (lambda (,@(mapcar #'car bindings)) (let ((form `(funcall (lambda (,@(mapcar #'car bindings))
,@(macroexp-unprogn body)) ,@(macroexp-unprogn body))
,@(mapcar #'cadr bindings))) ,@(mapcar #'cadr bindings))))
(if (not nowarn) form
`(with-suppressed-warnings ((lexical ,@dyns)) ,form))))
((null (cdr bindings)) ((null (cdr bindings))
(macroexp-let* bindings body)) (macroexp-let* bindings body))
(t `(let ,bindings ,@(macroexp-unprogn 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)))) (if (and whole (not (cl--safe-expr-p (macroexp-progn argvs))))
whole whole
;; Function arguments are unconditionally statically scoped (bug#47552). ;; 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. ;;; Structures.
@ -3012,6 +3015,7 @@ To see the documentation for a defined struct type, use
(defsym (if cl--struct-inline 'cl-defsubst 'defun)) (defsym (if cl--struct-inline 'cl-defsubst 'defun))
(forms nil) (forms nil)
(docstring (if (stringp (car descs)) (pop descs))) (docstring (if (stringp (car descs)) (pop descs)))
(dynbound-slotnames '())
pred-form pred-check) pred-form pred-check)
;; Can't use `cl-check-type' yet. ;; Can't use `cl-check-type' yet.
(unless (cl--struct-name-p name) (unless (cl--struct-name-p name)
@ -3131,6 +3135,8 @@ To see the documentation for a defined struct type, use
(while descp (while descp
(let* ((desc (pop descp)) (let* ((desc (pop descp))
(slot (pop desc))) (slot (pop desc)))
(when (macroexp--dynamic-variable-p slot)
(push slot dynbound-slotnames))
(if (memq slot '(cl-tag-slot cl-skip-slot)) (if (memq slot '(cl-tag-slot cl-skip-slot))
(progn (progn
(push nil slots) (push nil slots)
@ -3261,7 +3267,10 @@ To see the documentation for a defined struct type, use
;; forms)) ;; forms))
`(progn `(progn
(defvar ,tag-symbol) (defvar ,tag-symbol)
,@(nreverse forms) ,@(if (null dynbound-slotnames)
(nreverse forms)
`((with-suppressed-warnings ((lexical . ,dynbound-slotnames))
,@(nreverse forms))))
:autoload-end :autoload-end
;; Call cl-struct-define during compilation as well, so that ;; Call cl-struct-define during compilation as well, so that
;; a subsequent cl-defstruct in the same file can correctly include this ;; a subsequent cl-defstruct in the same file can correctly include this