From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Thu, 16 May 2019 19:29:36 +0000 (-0400)
Subject: * lisp/emacs-lisp/cl-macs.el (cl--sm-macroexpand) <setq>: Rewrite
X-Git-Tag: emacs-27.0.90~2871
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=37c41c6ef01de5bf16948eb67c4a9da6c7158b34;p=emacs.git

* lisp/emacs-lisp/cl-macs.el (cl--sm-macroexpand) <setq>: Rewrite

The previous code had 2 problems:
- It converted `setq` to `setf` in unrelated cases such as
  (cl-symbol-macrolet ((x 1)) (setq (car foo) bar))
- It macroexpanded places before `setf` had a chance to see if they
  have a gv-expander.
---

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 16e9bd6a750..23c4351c7ca 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2145,16 +2145,26 @@ of `cl-symbol-macrolet' to additionally expand symbol macros."
              (let ((symval (assq exp venv)))
                (when symval
                  (setq exp (cadr symval)))))
-            (`(setq . ,_)
+            (`(setq . ,args)
              ;; Convert setq to setf if required by symbol-macro expansion.
-             (let* ((args (mapcar (lambda (f) (macroexpand f env))
-                                  (cdr exp)))
-                    (p args))
-               (while (and p (symbolp (car p))) (setq p (cddr p)))
-               (if p (setq exp (cons 'setf args))
-                 (setq exp (cons 'setq args))
-                 ;; Don't loop further.
-                 nil)))
+             (let ((convert nil)
+                   (rargs nil))
+               (while args
+                 (let ((place (pop args)))
+                   ;; Here, we know `place' should be a symbol.
+                   (while
+                       (let ((symval (assq place venv)))
+                         (when symval
+                           (setq place (cadr symval))
+                           (if (symbolp place)
+                               t        ;Repeat.
+                             (setq convert t)
+                             nil))))
+                   (push place rargs)
+                   (push (pop args) rargs)))
+               (setq exp (cons (if convert 'setf 'setq)
+                               (nreverse rargs)))
+               convert))
             ;; CL's symbol-macrolet used to treat re-bindings as candidates for
             ;; expansion (turning the let into a letf if needed), contrary to
             ;; Common-Lisp where such re-bindings hide the symbol-macro.