[COMMIT] Make sure distinct symbol macros with identical names expand distinctly.

This still has a problem on non-bignum builds, where the Lisp-visible eq-hash is not guaranteed distinct for any two symbols (since pointer values are not all representable as Lisp integers, they are truncated before escaping) This will be relevant with very large positive or very large negative values in address space; if anyone’s working on a machine that does this, shout, and we can think about this some more. APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1303635165 -3600 # Node ID 97ac18bd1fa393a50e607f6713afbbc4fd7bf5c8 # Parent 568ec109e73dcf3107daae6324ad4fb04e05077b Make sure distinct symbol macros with identical names expand distinctly. lisp/ChangeLog addition: 2011-04-24 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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(a)parhasard.net&gt; * automated/lisp-tests.el: Check that distinct symbol macros with identical string names expand to different things. diff -r 568ec109e73d -r 97ac18bd1fa3 lisp/ChangeLog --- a/lisp/ChangeLog Sat Apr 23 22:42:10 2011 +0100 +++ b/lisp/ChangeLog Sun Apr 24 09:52:45 2011 +0100 ＠＠ -1,3 +1,14 ＠＠ +2011-04-24 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * 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. + 2011-04-23 Aidan Kehoe <kehoea(a)parhasard.net&gt; * cl-extra.el (define-char-comparisons): diff -r 568ec109e73d -r 97ac18bd1fa3 lisp/cl-macs.el --- 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) diff -r 568ec109e73d -r 97ac18bd1fa3 lisp/cl.el --- a/lisp/cl.el Sat Apr 23 22:42:10 2011 +0100 +++ b/lisp/cl.el Sun Apr 24 09:52:45 2011 +0100 ＠＠ -229,11 +229,17 ＠＠ The second optional arg ENVIRONMENT specifies an environment of macro definitions to shadow the loaded ones for use in file byte-compilation." - (let ((cl-macro-environment cl-env)) - (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env)) + (let ((cl-macro-environment + (if cl-macro-environment (append cl-env cl-macro-environment) cl-env)) + eq-hash) + (while (progn (setq cl-macro + (macroexpand-internal cl-macro cl-macro-environment)) (and (symbolp cl-macro) - (cdr (assq (symbol-name cl-macro) cl-env)))) - (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env)))) + (setq eq-hash (eq-hash cl-macro)) + (if (fixnump eq-hash) + (assq eq-hash cl-macro-environment) + (assoc eq-hash cl-macro-environment)))) + (setq cl-macro (cadr (assoc* eq-hash cl-macro-environment)))) cl-macro)) ;;; Declarations. diff -r 568ec109e73d -r 97ac18bd1fa3 tests/ChangeLog --- a/tests/ChangeLog Sat Apr 23 22:42:10 2011 +0100 +++ b/tests/ChangeLog Sun Apr 24 09:52:45 2011 +0100 ＠＠ -1,3 +1,9 ＠＠ +2011-04-24 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * automated/lisp-tests.el: + Check that distinct symbol macros with identical string names + expand to different things. + 2011-03-24 Jerry James <james(a)xemacs.org&gt; * automated/query-coding-tests.el: "Compatiblity" -> "Compatibility". diff -r 568ec109e73d -r 97ac18bd1fa3 tests/automated/lisp-tests.el --- a/tests/automated/lisp-tests.el Sat Apr 23 22:42:10 2011 +0100 +++ b/tests/automated/lisp-tests.el Sun Apr 24 09:52:45 2011 +0100 ＠＠ -2914,4 +2914,18 ＠＠ "the function special operator doesn't create a lexical context.")) (Assert (eql 0 (needs-lexical-context 2 nil nil))))) +;; Test symbol-macrolet with symbols with identical string names. + +(macrolet + ((test-symbol-macrolet () + (let* ((symbol 'my-symbol) + (copy-symbol (copy-symbol symbol)) + (third (copy-symbol copy-symbol))) + `(symbol-macrolet ((,symbol [symbol expansion]) + (,copy-symbol [copy expansion]) + (,third [third expansion])) + (list ,symbol ,copy-symbol ,third))))) + (Assert (equal '([symbol expansion] [copy expansion] [third expansion]) + (test-symbol-macrolet)))) + ;;; end of lisp-tests.el -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches