- (let ((rest (cdr form)))
- (if (cdr (cdr (cdr form)))
- ;; emit multiple calls to set-default if necessary; all but last
- ;; for-effect (this recurses.)
- (while rest
- (byte-compile-form
- (list 'set-default (car rest) (car (cdr rest)))
- (not (null (cdr rest))))
- (setq rest (cdr (cdr rest))))
- ;; else, this is the one-armed version
- (let ((var (nth 1 form))
- ;;(val (nth 2 form))
- )
- ;; notice calls to set-default/setq-default for variables which
- ;; have not been declared with defvar/defconst.
- (if (and (memq 'free-vars byte-compile-warnings)
- (or (null var)
- (and (eq (car-safe var) 'quote)
- (= 2 (length var)))))
- (let ((sym (nth 1 var))
- cell)
- (or (and sym (symbolp sym) (globally-boundp sym))
- (and (setq cell (assq sym byte-compile-bound-variables))
- (setcdr cell (logior (cdr cell)
- byte-compile-assigned-bit)))
- (memq sym byte-compile-free-assignments)
- (if (or (not (symbolp sym)) (memq sym '(t nil)))
- (progn
- (byte-compile-warn
- "Attempt to set-globally %s %s"
- (if (symbolp sym) "constant" "nonvariable")
- (prin1-to-string sym)))
- (progn
- (byte-compile-warn "assignment to free variable %s" sym)
- (setq byte-compile-free-assignments
- (cons sym byte-compile-free-assignments)))))))
- ;; now emit a normal call to set-default (or possibly multiple calls)
- (byte-compile-normal-call form)))))
+ (let* ((args (cdr form))
+ (nargs (length args))
+ (var (car args)))
+ (when (and (= (safe-length var) 2)
+ (eq (car var) 'quote))
+ (let ((sym (nth 1 var)))
+ (cond
+ ((not (symbolp sym))
+ (byte-compile-warn "Attempt to set-globally non-symbol %s" sym))
+ ((byte-compile-constant-symbol-p sym)
+ (byte-compile-warn "Attempt to set-globally constant symbol %s" sym))
+ ((let ((cell (assq sym byte-compile-bound-variables)))
+ (and cell
+ (setcdr cell (logior (cdr cell) byte-compile-assigned-bit))
+ t)))
+ ;; notice calls to set-default/setq-default for variables which
+ ;; have not been declared with defvar/defconst.
+ ((globally-boundp sym)) ; OK
+ ((not (memq 'free-vars byte-compile-warnings))) ; warnings suppressed?
+ ((memq sym byte-compile-free-assignments)) ; already warned about sym
+ (t
+ (byte-compile-warn "assignment to free variable %s" sym)
+ (push sym byte-compile-free-assignments)))))
+ (if (= nargs 2)
+ ;; now emit a normal call to set-default
+ (byte-compile-normal-call form)
+ (byte-compile-subr-wrong-args form 2))))