procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
1 changed files with 19 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
lisp/emacs-lisp/cl-macs.el
View file

@ -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.