emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] master 89898e4: * lisp/emacs-lisp/cl-macs.el: Fix symbol-m


From: Stefan Monnier
Subject: [Emacs-diffs] master 89898e4: * lisp/emacs-lisp/cl-macs.el: Fix symbol-macrolet
Date: Fri, 21 Apr 2017 12:12:48 -0400 (EDT)

branch: master
commit 89898e43c7ceef28bb3c2116b4d8a3ec96d9c8da
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * 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.
---
 lisp/emacs-lisp/cl-macs.el           | 17 +++++++++++++----
 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 ecb89fd..db1518c 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 564ddab..65bd97f 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))))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]