diff options
| author | Stefan Monnier | 2017-04-21 12:12:42 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2017-04-21 12:12:42 -0400 |
| commit | 89898e43c7ceef28bb3c2116b4d8a3ec96d9c8da (patch) | |
| tree | 9293d75b2a88d3744dcc2a7a3fc778157fdf3d62 | |
| parent | 72d7961d678f9c5f4cb812e0bb9b6dffafb47c68 (diff) | |
| download | emacs-89898e43c7ceef28bb3c2116b4d8a3ec96d9c8da.tar.gz emacs-89898e43c7ceef28bb3c2116b4d8a3ec96d9c8da.zip | |
* lisp/emacs-lisp/cl-macs.el: Fix symbol-macrolet
Revert 0d112c00ba0ec14bd3014efcd3430b9ddcfe1fc1 (to fix bug#26325)
and use a different fix for bug#26068.
(cl--symbol-macro-key): New function.
(cl--sm-macroexpand, cl-symbol-macrolet): Use it instead of `symbol-name`.
* test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-symbol-macrolet):
Failure is not expected any more.
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 17 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/cl-lib-tests.el | 1 |
2 files changed, 13 insertions, 5 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index ecb89fd51d7..db1518ce611 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el | |||
| @@ -2047,6 +2047,12 @@ This is like `cl-flet', but for macros instead of functions. | |||
| 2047 | cl--old-macroexpand | 2047 | cl--old-macroexpand |
| 2048 | (symbol-function 'macroexpand))) | 2048 | (symbol-function 'macroexpand))) |
| 2049 | 2049 | ||
| 2050 | (defun cl--symbol-macro-key (sym) | ||
| 2051 | "Return the key used in `macroexpand-all-environment' for symbol macro SYM." | ||
| 2052 | ;; In the past we've used `symbol-name' instead, but that doesn't | ||
| 2053 | ;; preserve the `eq'uality between different symbols of the same name. | ||
| 2054 | `(:cl-symbol-macro . ,sym)) | ||
| 2055 | |||
| 2050 | (defun cl--sm-macroexpand (exp &optional env) | 2056 | (defun cl--sm-macroexpand (exp &optional env) |
| 2051 | "Special macro expander used inside `cl-symbol-macrolet'. | 2057 | "Special macro expander used inside `cl-symbol-macrolet'. |
| 2052 | This function replaces `macroexpand' during macro expansion | 2058 | This function replaces `macroexpand' during macro expansion |
| @@ -2059,8 +2065,10 @@ except that it additionally expands symbol macros." | |||
| 2059 | (pcase exp | 2065 | (pcase exp |
| 2060 | ((pred symbolp) | 2066 | ((pred symbolp) |
| 2061 | ;; Perform symbol-macro expansion. | 2067 | ;; Perform symbol-macro expansion. |
| 2062 | (when (cdr (assq exp env)) | 2068 | ;; FIXME: Calling `cl--symbol-macro-key' for every var reference |
| 2063 | (setq exp (cadr (assq exp env))))) | 2069 | ;; is a bit more costly than I'd like. |
| 2070 | (when (cdr (assoc (cl--symbol-macro-key exp) env)) | ||
| 2071 | (setq exp (cadr (assoc (cl--symbol-macro-key exp) env))))) | ||
| 2064 | (`(setq . ,_) | 2072 | (`(setq . ,_) |
| 2065 | ;; Convert setq to setf if required by symbol-macro expansion. | 2073 | ;; Convert setq to setf if required by symbol-macro expansion. |
| 2066 | (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f env)) | 2074 | (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f env)) |
| @@ -2078,7 +2086,7 @@ except that it additionally expands symbol macros." | |||
| 2078 | (let ((letf nil) (found nil) (nbs ())) | 2086 | (let ((letf nil) (found nil) (nbs ())) |
| 2079 | (dolist (binding bindings) | 2087 | (dolist (binding bindings) |
| 2080 | (let* ((var (if (symbolp binding) binding (car binding))) | 2088 | (let* ((var (if (symbolp binding) binding (car binding))) |
| 2081 | (sm (assq var env))) | 2089 | (sm (assoc (cl--symbol-macro-key var) env))) |
| 2082 | (push (if (not (cdr sm)) | 2090 | (push (if (not (cdr sm)) |
| 2083 | binding | 2091 | binding |
| 2084 | (let ((nexp (cadr sm))) | 2092 | (let ((nexp (cadr sm))) |
| @@ -2149,7 +2157,8 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). | |||
| 2149 | (let ((expansion | 2157 | (let ((expansion |
| 2150 | ;; FIXME: For N bindings, this will traverse `body' N times! | 2158 | ;; FIXME: For N bindings, this will traverse `body' N times! |
| 2151 | (macroexpand-all (macroexp-progn body) | 2159 | (macroexpand-all (macroexp-progn body) |
| 2152 | (cons (list (caar bindings) | 2160 | (cons (list (cl--symbol-macro-key |
| 2161 | (caar bindings)) | ||
| 2153 | (cl-cadar bindings)) | 2162 | (cl-cadar bindings)) |
| 2154 | macroexpand-all-environment)))) | 2163 | macroexpand-all-environment)))) |
| 2155 | (if (or (null (cdar bindings)) (cl-cddar bindings)) | 2164 | (if (or (null (cdar bindings)) (cl-cddar bindings)) |
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 564ddab67db..65bd97f3b2d 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el | |||
| @@ -495,7 +495,6 @@ | |||
| 495 | 495 | ||
| 496 | (ert-deftest cl-lib-symbol-macrolet () | 496 | (ert-deftest cl-lib-symbol-macrolet () |
| 497 | ;; bug#26325 | 497 | ;; bug#26325 |
| 498 | :expected-result :failed | ||
| 499 | (should (equal (cl-flet ((f (x) (+ x 5))) | 498 | (should (equal (cl-flet ((f (x) (+ x 5))) |
| 500 | (let ((x 5)) | 499 | (let ((x 5)) |
| 501 | (f (+ x 6)))) | 500 | (f (+ x 6)))) |