diff options
| author | Stefan Monnier | 2019-05-16 15:29:36 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2019-05-16 15:29:36 -0400 |
| commit | 37c41c6ef01de5bf16948eb67c4a9da6c7158b34 (patch) | |
| tree | ac09a26cd2860e5280dce438a89d95450b6410f5 | |
| parent | 4ac234ad576cf9068419805ef338701024265afb (diff) | |
| download | emacs-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.el | 28 |
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. |