Normalise setq during macro-expansion

Early normalisation of setq during macroexpand-all allows later
stages, cconv, byte-opt and codegen, to be simplified and duplicated
checks to be eliminated.

* lisp/emacs-lisp/macroexp.el (macroexp--expand-all):
Normalise all setq forms to a sequence of (setq VAR EXPR).
Emit warnings if necessary.
* lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyze-form):
* lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker):
* lisp/emacs-lisp/bytecomp.el (byte-compile-setq):
Simplify.
* test/lisp/emacs-lisp/bytecomp-tests.el: Adapt and add tests.
* test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-nonvariable.el;
* test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-odd.el:
New files.

lisp/emacs-lisp/byte-opt.el

@@ -463,32 +463,21 @@ for speeding up processing.")
       ;; is a *value* and shouldn't appear in the car.
       (`((closure . ,_) . ,_) form)
 
-      (`(setq . ,args)
+      (`(setq ,var ,expr)
-       (let ((var-expr-list nil))
+       (let ((lexvar (assq var byte-optimize--lexvars))
-         (while args
+             (value (byte-optimize-form expr nil)))
-           (unless (and (consp args)
+         (when lexvar
-                        (symbolp (car args)) (consp (cdr args)))
+           (setcar (cdr lexvar) t)    ; Mark variable to be kept.
-             (byte-compile-warn-x form "malformed setq form: %S" form))
+           (setcdr (cdr lexvar) nil)  ; Inhibit further substitution.
-           (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)
+           (when (memq var byte-optimize--aliased-vars)
-                 ;; Cancel aliasing of variables aliased to this one.
+             ;; Cancel aliasing of variables aliased to this one.
-                 (dolist (v byte-optimize--lexvars)
+             (dolist (v byte-optimize--lexvars)
-                   (when (eq (nth 2 v) var)
+               (when (eq (nth 2 v) var)
-                     ;; V is bound to VAR but VAR is now mutated:
+                 ;; V is bound to VAR but VAR is now mutated:
-                     ;; cancel aliasing.
+                 ;; cancel aliasing.
-                     (setcdr (cdr v) nil)))))
+                 (setcdr (cdr v) nil)))))
-
+         `(,fn ,var ,value)))
-             (push var var-expr-list)
-             (push value var-expr-list))
-           (setq args (cddr args)))
-         (cons fn (nreverse var-expr-list))))
 
       (`(defvar ,(and (pred symbolp) name) . ,rest)
        (let ((optimized-rest (and rest

lisp/emacs-lisp/bytecomp.el

@@ -4225,25 +4225,13 @@ This function is never called when `lexical-binding' is nil."
 (byte-defop-compiler-1 quote)
 
 (defun byte-compile-setq (form)
-  (let* ((args (cdr form))
+  (cl-assert (= (length form) 3))       ; normalised in macroexp
-         (len (length args)))
+  (let ((var (nth 1 form))
-    (if (= (logand len 1) 1)
+        (expr (nth 2 form)))
-        (progn
+    (byte-compile-form expr)
-          (byte-compile-report-error
+    (unless byte-compile--for-effect
-           (format-message
+      (byte-compile-out 'byte-dup 0))
-            "missing value for `%S' at end of setq" (car (last args))))
+    (byte-compile-variable-set var)
-          (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)))
     (setq byte-compile--for-effect nil)))
 
 (byte-defop-compiler-1 set-default)

lisp/emacs-lisp/cconv.el

@@ -555,29 +555,19 @@ places where they originally did not directly appear."
      `(,(car form) ,(cconv-convert form1 env extend)
         :fun-body ,(cconv--convert-function () body env form1)))
 
-    (`(setq . ,forms)                   ; setq special form
+    (`(setq ,var ,expr)
-     (if (= (logand (length forms) 1) 1)
+     (let ((var-new (or (cdr (assq var env)) var))
-         ;; With an odd number of args, let bytecomp.el handle the error.
+           (value (cconv-convert expr env extend)))
-         form
+       (pcase var-new
-       (let ((prognlist ()))
+         ((pred symbolp) `(,(car form) ,var-new ,value))
-         (while forms
+         (`(car-safe ,iexp) `(setcar ,iexp ,value))
-           (let* ((sym (pop forms))
+         ;; This "should never happen", but for variables which are
-                  (sym-new (or (cdr (assq sym env)) sym))
+         ;; mutated+captured+unused, we may end up trying to `setq'
-                  (value (cconv-convert (pop forms) env extend)))
+         ;; on a closed-over variable, so just drop the setq.
-             (push (pcase sym-new
+         (_ ;; (byte-compile-report-error
-                     ((pred symbolp) `(,(car form) ,sym-new ,value))
+          ;;  (format "Internal error in cconv of (setq %s ..)"
-                     (`(car-safe ,iexp) `(setcar ,iexp ,value))
+          ;;          sym-new))
-                     ;; This "should never happen", but for variables which are
+          value))))
-                     ;; 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)))))
 
     (`(,(and (or 'funcall 'apply) callsym) ,fun . ,args)
      ;; These are not special forms but we treat them separately for the needs
@@ -751,14 +741,13 @@ This function does not return anything but instead fills the
        (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 var env))) ; v = non nil if visible
-       (let ((v (assq (car forms) env))) ; v = non nil if visible
+       (when v
-         (when v (setf (nth 2 v) t)))
+         (setf (nth 2 v) t)))
-       (cconv-analyze-form (cadr forms) env)
+     (cconv-analyze-form expr env))
-       (setq forms (cddr forms))))
 
     (`((lambda . ,_) . ,_)             ; First element is lambda expression.
      (byte-compile-warn-x

lisp/emacs-lisp/macroexp.el

@@ -369,6 +369,54 @@ Assumes the caller has bound `macroexpand-all-environment'."
                    (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,

test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-nonvariable.el

@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defun foo ()
+  (setq (a) nil))

test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-odd.el

@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defun foo (a b)
+  (setq a 1 b))

test/lisp/emacs-lisp/bytecomp-tests.el

@@ -951,11 +951,17 @@ byte-compiled.  Run with dynamic binding."
                             "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")