master 6825e5686a 1/3: Normalise setq during macro-expansion

[Mattias Engdegård]

branch: master
commit 6825e5686a4bf21f5d5a0ae1af889097cfa2f597
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    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                        | 41 +++++++-----------
 lisp/emacs-lisp/bytecomp.el                        | 26 ++++--------
 lisp/emacs-lisp/cconv.el                           | 47 ++++++++-------------
 lisp/emacs-lisp/macroexp.el                        | 48 ++++++++++++++++++++++
 .../warn-variable-setq-nonvariable.el              |  3 ++
 .../bytecomp-resources/warn-variable-setq-odd.el   |  3 ++
 test/lisp/emacs-lisp/bytecomp-tests.el             |  8 +++-
 7 files changed, 101 insertions(+), 75 deletions(-)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 69795f9c11..0e10e332b2 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/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)
-       (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
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index ab21fba8a2..1f868d2217 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/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))
-         (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)
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 1a501f50bf..b12f1db677 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/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
-     (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
@@ -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 (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
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 51c6e8e0ca..bae303c213 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/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,
diff --git 
a/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-nonvariable.el 
b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-nonvariable.el
new file mode 100644
index 0000000000..5a56913cd9
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-nonvariable.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defun foo ()
+  (setq (a) nil))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-odd.el 
b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-odd.el
new file mode 100644
index 0000000000..9ce80de08c
--- /dev/null
+++ b/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))
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el 
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 27098d0bb1..9abc17a1c4 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ 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")