aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-05-16 15:29:36 -0400
committerStefan Monnier2019-05-16 15:29:36 -0400
commit37c41c6ef01de5bf16948eb67c4a9da6c7158b34 (patch)
treeac09a26cd2860e5280dce438a89d95450b6410f5
parent4ac234ad576cf9068419805ef338701024265afb (diff)
downloademacs-37c41c6ef01de5bf16948eb67c4a9da6c7158b34.tar.gz
emacs-37c41c6ef01de5bf16948eb67c4a9da6c7158b34.zip
* 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.
-rw-r--r--lisp/emacs-lisp/cl-macs.el28
1 files changed, 19 insertions, 9 deletions
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."
2145 (let ((symval (assq exp venv))) 2145 (let ((symval (assq exp venv)))
2146 (when symval 2146 (when symval
2147 (setq exp (cadr symval))))) 2147 (setq exp (cadr symval)))))
2148 (`(setq . ,_) 2148 (`(setq . ,args)
2149 ;; Convert setq to setf if required by symbol-macro expansion. 2149 ;; Convert setq to setf if required by symbol-macro expansion.
2150 (let* ((args (mapcar (lambda (f) (macroexpand f env)) 2150 (let ((convert nil)
2151 (cdr exp))) 2151 (rargs nil))
2152 (p args)) 2152 (while args
2153 (while (and p (symbolp (car p))) (setq p (cddr p))) 2153 (let ((place (pop args)))
2154 (if p (setq exp (cons 'setf args)) 2154 ;; Here, we know `place' should be a symbol.
2155 (setq exp (cons 'setq args)) 2155 (while
2156 ;; Don't loop further. 2156 (let ((symval (assq place venv)))
2157 nil))) 2157 (when symval
2158 (setq place (cadr symval))
2159 (if (symbolp place)
2160 t ;Repeat.
2161 (setq convert t)
2162 nil))))
2163 (push place rargs)
2164 (push (pop args) rargs)))
2165 (setq exp (cons (if convert 'setf 'setq)
2166 (nreverse rargs)))
2167 convert))
2158 ;; CL's symbol-macrolet used to treat re-bindings as candidates for 2168 ;; CL's symbol-macrolet used to treat re-bindings as candidates for
2159 ;; expansion (turning the let into a letf if needed), contrary to 2169 ;; expansion (turning the let into a letf if needed), contrary to
2160 ;; Common-Lisp where such re-bindings hide the symbol-macro. 2170 ;; Common-Lisp where such re-bindings hide the symbol-macro.