(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))))))
(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.
(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)
(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)
;; 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