aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2017-04-21 12:12:42 -0400
committerStefan Monnier2017-04-21 12:12:42 -0400
commit89898e43c7ceef28bb3c2116b4d8a3ec96d9c8da (patch)
tree9293d75b2a88d3744dcc2a7a3fc778157fdf3d62
parent72d7961d678f9c5f4cb812e0bb9b6dffafb47c68 (diff)
downloademacs-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.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.
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'.
2052This function replaces `macroexpand' during macro expansion 2058This 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))))