summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2017-04-21 12:12:42 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2017-04-21 12:12:42 -0400
commit89898e43c7ceef28bb3c2116b4d8a3ec96d9c8da (patch)
tree9293d75b2a88d3744dcc2a7a3fc778157fdf3d62
parent72d7961d678f9c5f4cb812e0bb9b6dffafb47c68 (diff)
downloademacs-89898e43c7ceef28bb3c2116b4d8a3ec96d9c8da.tar.gz
* 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.el17
-rw-r--r--test/lisp/emacs-lisp/cl-lib-tests.el1
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.
cl--old-macroexpand
(symbol-function 'macroexpand)))
+(defun cl--symbol-macro-key (sym)
+ "Return the key used in `macroexpand-all-environment' for symbol macro SYM."
+ ;; In the past we've used `symbol-name' instead, but that doesn't
+ ;; preserve the `eq'uality between different symbols of the same name.
+ `(:cl-symbol-macro . ,sym))
+
(defun cl--sm-macroexpand (exp &optional env)
"Special macro expander used inside `cl-symbol-macrolet'.
This function replaces `macroexpand' during macro expansion
@@ -2059,8 +2065,10 @@ except that it additionally expands symbol macros."
(pcase exp
((pred symbolp)
;; Perform symbol-macro expansion.
- (when (cdr (assq exp env))
- (setq exp (cadr (assq exp env)))))
+ ;; FIXME: Calling `cl--symbol-macro-key' for every var reference
+ ;; is a bit more costly than I'd like.
+ (when (cdr (assoc (cl--symbol-macro-key exp) env))
+ (setq exp (cadr (assoc (cl--symbol-macro-key exp) env)))))
(`(setq . ,_)
;; Convert setq to setf if required by symbol-macro expansion.
(let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f env))
@@ -2078,7 +2086,7 @@ except that it additionally expands symbol macros."
(let ((letf nil) (found nil) (nbs ()))
(dolist (binding bindings)
(let* ((var (if (symbolp binding) binding (car binding)))
- (sm (assq var env)))
+ (sm (assoc (cl--symbol-macro-key var) env)))
(push (if (not (cdr sm))
binding
(let ((nexp (cadr sm)))
@@ -2149,7 +2157,8 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
(let ((expansion
;; FIXME: For N bindings, this will traverse `body' N times!
(macroexpand-all (macroexp-progn body)
- (cons (list (caar bindings)
+ (cons (list (cl--symbol-macro-key
+ (caar bindings))
(cl-cadar bindings))
macroexpand-all-environment))))
(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 @@
(ert-deftest cl-lib-symbol-macrolet ()
;; bug#26325
- :expected-result :failed
(should (equal (cl-flet ((f (x) (+ x 5)))
(let ((x 5))
(f (+ x 6))))