Mercurial > hg > xemacs-beta

comparison lisp/cl-macs.el @ 5462:97ac18bd1fa3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
5461:568ec109e73d 5462:97ac18bd1fa3
1789 ;;;###autoload 1789 ;;;###autoload
1790 (defmacro* symbol-macrolet (((name expansion) &rest symbol-macros) &body form) 1790 (defmacro* symbol-macrolet (((name expansion) &rest symbol-macros) &body form)
1791 "Make symbol macro definitions. 1791 "Make symbol macro definitions.
1792 Within the body FORMs, references to the variable NAME will be replaced 1792 Within the body FORMs, references to the variable NAME will be replaced
1793 by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)." 1793 by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)."
1794 (check-type name symbol)
1794 (cl-macroexpand-all (cons 'progn form) 1795 (cl-macroexpand-all (cons 'progn form)
1795 (append (list (list (symbol-name name) expansion)) 1796 (nconc (list (list (eq-hash name) expansion))
1796 (loop 1797 (loop
1797 for (name expansion) in symbol-macros 1798 for (name expansion) in symbol-macros
1798 collect (list (symbol-name name) expansion)) 1799 do (check-type name symbol)
1799 cl-macro-environment))) 1800 collect (list (eq-hash name) expansion))
1801 cl-macro-environment)))
1800 1802
1801 (defvar cl-closure-vars nil) 1803 (defvar cl-closure-vars nil)
1802 ;;;###autoload 1804 ;;;###autoload
1803 (defmacro lexical-let (bindings &rest body) 1805 (defmacro lexical-let (bindings &rest body)
1804 "Like `let', but lexically scoped. 1806 "Like `let', but lexically scoped.
1805 The main visible difference is that lambdas inside BODY will create 1807 The main visible difference is that lambdas inside BODY will create
1806 lexical closures as in Common Lisp." 1808 lexical closures as in Common Lisp."
1807 (let* ((cl-closure-vars cl-closure-vars) 1809 (let* ((cl-closure-vars cl-closure-vars)
1808 (vars (mapcar #'(lambda (x) 1810 (vars (mapcar #'(lambda (x)
1809 (or (consp x) (setq x (list x))) 1811 (or (consp x) (setq x (list x)))
1810 (push (gensym (format "--%s--" (car x))) 1812 (push (gensym (concat "--" (symbol-name (car x))
1811 cl-closure-vars) 1813 "--" ))
1814 cl-closure-vars)
1812 (set (car cl-closure-vars) [bad-lexical-ref]) 1815 (set (car cl-closure-vars) [bad-lexical-ref])
1813 (list (car x) (cadr x) (car cl-closure-vars))) 1816 (list (car x) (cadr x) (car cl-closure-vars)))
1814 bindings)) 1817 bindings))
1815 (ebody 1818 (ebody
1816 (cl-macroexpand-all 1819 (cl-macroexpand-all
1817 (cons 'progn body) 1820 (cons 'progn body)
1818 (nconc (mapcar #'(lambda (x) 1821 (nconc (mapcar #'(lambda (x)
1819 (list (symbol-name (car x)) 1822 (list (eq-hash (car x))
1820 (list 'symbol-value (caddr x)) 1823 (list 'symbol-value (caddr x))
1821 t)) 1824 t))
1822 vars) 1825 vars)
1823 (list '(defun . cl-defun-expander)) 1826 (list '(defun . cl-defun-expander))
1824 cl-macro-environment)))) 1827 cl-macro-environment))))