* 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.
This commit is contained in:
Stefan Monnier 2019-05-16 15:29:36 -04:00
parent 4ac234ad57
commit 37c41c6ef0

View file

@ -2145,16 +2145,26 @@ of `cl-symbol-macrolet' to additionally expand symbol macros."
(let ((symval (assq exp venv))) (let ((symval (assq exp venv)))
(when symval (when symval
(setq exp (cadr symval))))) (setq exp (cadr symval)))))
(`(setq . ,_) (`(setq . ,args)
;; Convert setq to setf if required by symbol-macro expansion. ;; Convert setq to setf if required by symbol-macro expansion.
(let* ((args (mapcar (lambda (f) (macroexpand f env)) (let ((convert nil)
(cdr exp))) (rargs nil))
(p args)) (while args
(while (and p (symbolp (car p))) (setq p (cddr p))) (let ((place (pop args)))
(if p (setq exp (cons 'setf args)) ;; Here, we know `place' should be a symbol.
(setq exp (cons 'setq args)) (while
;; Don't loop further. (let ((symval (assq place venv)))
nil))) (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 ;; CL's symbol-macrolet used to treat re-bindings as candidates for
;; expansion (turning the let into a letf if needed), contrary to ;; expansion (turning the let into a letf if needed), contrary to
;; Common-Lisp where such re-bindings hide the symbol-macro. ;; Common-Lisp where such re-bindings hide the symbol-macro.