From: Stefan Monnier Date: Fri, 21 Apr 2017 16:12:42 +0000 (-0400) Subject: * lisp/emacs-lisp/cl-macs.el: Fix symbol-macrolet X-Git-Tag: emacs-26.0.90~521^2~582 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=89898e43c7ceef28bb3c2116b4d8a3ec96d9c8da;p=emacs.git * 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. --- 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))))