Mercurial > hg > xemacs-beta
diff lisp/cl-macs.el @ 5462:97ac18bd1fa3
Make sure distinct symbol macros with identical names expand distinctly.
lisp/ChangeLog addition:
2011-04-24 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (symbol-macrolet):
* cl-macs.el (lexical-let):
* cl.el:
* cl.el (cl-macroexpand):
Distinct symbol macros with identical string names should
nonetheless expand to different things; implement this, storing
the symbol's eq-hash in the macro environment, rather than its
string name.
tests/ChangeLog addition:
2011-04-24 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Check that distinct symbol macros with identical string names
expand to different things.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 24 Apr 2011 09:52:45 +0100 |
| parents | f9dc75bdbdc4 |
| children | f2881cb841b4 |
line wrap: on
line diff
--- a/lisp/cl-macs.el Sat Apr 23 22:42:10 2011 +0100 +++ b/lisp/cl-macs.el Sun Apr 24 09:52:45 2011 +0100 @@ -1791,12 +1791,14 @@ "Make symbol macro definitions. Within the body FORMs, references to the variable NAME will be replaced by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)." + (check-type name symbol) (cl-macroexpand-all (cons 'progn form) - (append (list (list (symbol-name name) expansion)) - (loop - for (name expansion) in symbol-macros - collect (list (symbol-name name) expansion)) - cl-macro-environment))) + (nconc (list (list (eq-hash name) expansion)) + (loop + for (name expansion) in symbol-macros + do (check-type name symbol) + collect (list (eq-hash name) expansion)) + cl-macro-environment))) (defvar cl-closure-vars nil) ;;;###autoload @@ -1807,8 +1809,9 @@ (let* ((cl-closure-vars cl-closure-vars) (vars (mapcar #'(lambda (x) (or (consp x) (setq x (list x))) - (push (gensym (format "--%s--" (car x))) - cl-closure-vars) + (push (gensym (concat "--" (symbol-name (car x)) + "--" )) + cl-closure-vars) (set (car cl-closure-vars) [bad-lexical-ref]) (list (car x) (cadr x) (car cl-closure-vars))) bindings)) @@ -1816,7 +1819,7 @@ (cl-macroexpand-all (cons 'progn body) (nconc (mapcar #'(lambda (x) - (list (symbol-name (car x)) + (list (eq-hash (car x)) (list 'symbol-value (caddr x)) t)) vars)