;; is a *value* and shouldn't appear in the car.
(`((closure . ,_) . ,_) form)
- (`(setq . ,args)
- (let ((var-expr-list nil))
- (while args
- (unless (and (consp args)
- (symbolp (car args)) (consp (cdr args)))
- (byte-compile-warn-x form "malformed setq form: %S" form))
- (let* ((var (car args))
- (expr (cadr args))
- (lexvar (assq var byte-optimize--lexvars))
- (value (byte-optimize-form expr nil)))
- (when lexvar
- (setcar (cdr lexvar) t) ; Mark variable to be kept.
- (setcdr (cdr lexvar) nil) ; Inhibit further substitution.
-
- (when (memq var byte-optimize--aliased-vars)
- ;; Cancel aliasing of variables aliased to this one.
- (dolist (v byte-optimize--lexvars)
- (when (eq (nth 2 v) var)
- ;; V is bound to VAR but VAR is now mutated:
- ;; cancel aliasing.
- (setcdr (cdr v) nil)))))
-
- (push var var-expr-list)
- (push value var-expr-list))
- (setq args (cddr args)))
- (cons fn (nreverse var-expr-list))))
+ (`(setq ,var ,expr)
+ (let ((lexvar (assq var byte-optimize--lexvars))
+ (value (byte-optimize-form expr nil)))
+ (when lexvar
+ (setcar (cdr lexvar) t) ; Mark variable to be kept.
+ (setcdr (cdr lexvar) nil) ; Inhibit further substitution.
+
+ (when (memq var byte-optimize--aliased-vars)
+ ;; Cancel aliasing of variables aliased to this one.
+ (dolist (v byte-optimize--lexvars)
+ (when (eq (nth 2 v) var)
+ ;; V is bound to VAR but VAR is now mutated:
+ ;; cancel aliasing.
+ (setcdr (cdr v) nil)))))
+ `(,fn ,var ,value)))
(`(defvar ,(and (pred symbolp) name) . ,rest)
(let ((optimized-rest (and rest
(byte-defop-compiler-1 quote)
(defun byte-compile-setq (form)
- (let* ((args (cdr form))
- (len (length args)))
- (if (= (logand len 1) 1)
- (progn
- (byte-compile-report-error
- (format-message
- "missing value for `%S' at end of setq" (car (last args))))
- (byte-compile-form
- `(signal 'wrong-number-of-arguments '(setq ,len))
- byte-compile--for-effect))
- (if args
- (while args
- (byte-compile-form (car (cdr args)))
- (or byte-compile--for-effect (cdr (cdr args))
- (byte-compile-out 'byte-dup 0))
- (byte-compile-variable-set (car args))
- (setq args (cdr (cdr args))))
- ;; (setq), with no arguments.
- (byte-compile-form nil byte-compile--for-effect)))
+ (cl-assert (= (length form) 3)) ; normalised in macroexp
+ (let ((var (nth 1 form))
+ (expr (nth 2 form)))
+ (byte-compile-form expr)
+ (unless byte-compile--for-effect
+ (byte-compile-out 'byte-dup 0))
+ (byte-compile-variable-set var)
(setq byte-compile--for-effect nil)))
(byte-defop-compiler-1 set-default)
`(,(car form) ,(cconv-convert form1 env extend)
:fun-body ,(cconv--convert-function () body env form1)))
- (`(setq . ,forms) ; setq special form
- (if (= (logand (length forms) 1) 1)
- ;; With an odd number of args, let bytecomp.el handle the error.
- form
- (let ((prognlist ()))
- (while forms
- (let* ((sym (pop forms))
- (sym-new (or (cdr (assq sym env)) sym))
- (value (cconv-convert (pop forms) env extend)))
- (push (pcase sym-new
- ((pred symbolp) `(,(car form) ,sym-new ,value))
- (`(car-safe ,iexp) `(setcar ,iexp ,value))
- ;; This "should never happen", but for variables which are
- ;; mutated+captured+unused, we may end up trying to `setq'
- ;; on a closed-over variable, so just drop the setq.
- (_ ;; (byte-compile-report-error
- ;; (format "Internal error in cconv of (setq %s ..)"
- ;; sym-new))
- value))
- prognlist)))
- (if (cdr prognlist)
- `(progn . ,(nreverse prognlist))
- (car prognlist)))))
+ (`(setq ,var ,expr)
+ (let ((var-new (or (cdr (assq var env)) var))
+ (value (cconv-convert expr env extend)))
+ (pcase var-new
+ ((pred symbolp) `(,(car form) ,var-new ,value))
+ (`(car-safe ,iexp) `(setcar ,iexp ,value))
+ ;; This "should never happen", but for variables which are
+ ;; mutated+captured+unused, we may end up trying to `setq'
+ ;; on a closed-over variable, so just drop the setq.
+ (_ ;; (byte-compile-report-error
+ ;; (format "Internal error in cconv of (setq %s ..)"
+ ;; sym-new))
+ value))))
(`(,(and (or 'funcall 'apply) callsym) ,fun . ,args)
;; These are not special forms but we treat them separately for the needs
(cconv-analyze-form (cadr (pop body-forms)) env))
(cconv--analyze-function vrs body-forms env form))
- (`(setq . ,forms)
+ (`(setq ,var ,expr)
;; If a local variable (member of env) is modified by setq then
;; it is a mutated variable.
- (while forms
- (let ((v (assq (car forms) env))) ; v = non nil if visible
- (when v (setf (nth 2 v) t)))
- (cconv-analyze-form (cadr forms) env)
- (setq forms (cddr forms))))
+ (let ((v (assq var env))) ; v = non nil if visible
+ (when v
+ (setf (nth 2 v) t)))
+ (cconv-analyze-form expr env))
(`((lambda . ,_) . ,_) ; First element is lambda expression.
(byte-compile-warn-x
(macroexp--all-forms body))
(cdr form))
form)))
+ (`(setq ,(and var (pred symbolp)
+ (pred (not booleanp)) (pred (not keywordp)))
+ ,expr)
+ ;; Fast path for the setq common case.
+ (let ((new-expr (macroexp--expand-all expr)))
+ (if (eq new-expr expr)
+ form
+ `(,fn ,var ,new-expr))))
+ (`(setq . ,args)
+ ;; Normalise to a sequence of (setq SYM EXPR).
+ ;; Malformed code is translated to code that signals an error
+ ;; at run time.
+ (let ((nargs (length args)))
+ (if (/= (logand nargs 1) 0)
+ (macroexp-warn-and-return
+ "odd number of arguments in `setq' form"
+ `(signal 'wrong-number-of-arguments '(setq ,nargs))
+ nil 'compile-only fn)
+ (let ((assignments nil))
+ (while (consp (cdr-safe args))
+ (let* ((var (car args))
+ (expr (cadr args))
+ (new-expr (macroexp--expand-all expr))
+ (assignment
+ (if (and (symbolp var)
+ (not (booleanp var)) (not (keywordp var)))
+ `(,fn ,var ,new-expr)
+ (macroexp-warn-and-return
+ (format-message "attempt to set %s `%s'"
+ (if (symbolp var)
+ "constant"
+ "non-variable")
+ var)
+ (cond
+ ((keywordp var)
+ ;; Accept `(setq :a :a)' for compatibility.
+ `(if (eq ,var ,new-expr)
+ ,var
+ (signal 'setting-constant (list ',var))))
+ ((symbolp var)
+ `(signal 'setting-constant (list ',var)))
+ (t
+ `(signal 'wrong-type-argument
+ (list 'symbolp ',var))))
+ nil 'compile-only var))))
+ (push assignment assignments))
+ (setq args (cddr args)))
+ (cons 'progn (nreverse assignments))))))
(`(,(and fun `(lambda . ,_)) . ,args)
;; Embedded lambda in function position.
;; If the byte-optimizer is loaded, try to unfold this,
--- /dev/null
+;;; -*- lexical-binding: t -*-
+(defun foo ()
+ (setq (a) nil))
--- /dev/null
+;;; -*- lexical-binding: t -*-
+(defun foo (a b)
+ (setq a 1 b))
"let-bind nonvariable")
(bytecomp--define-warning-file-test "warn-variable-set-constant.el"
- "variable reference to constant")
+ "attempt to set constant")
(bytecomp--define-warning-file-test "warn-variable-set-nonvariable.el"
"variable reference to nonvariable")
+(bytecomp--define-warning-file-test "warn-variable-setq-nonvariable.el"
+ "attempt to set non-variable")
+
+(bytecomp--define-warning-file-test "warn-variable-setq-odd.el"
+ "odd number of arguments")
+
(bytecomp--define-warning-file-test
"warn-wide-docstring-autoload.el"
"autoload .foox. docstring wider than .* characters")
projects / emacs.git / commitdiff