# HG changeset patch # User Stefan Monnier # Date 1254371932 0 # Node ID 507e3735eed8231d0b3736573743ed1035846a9e # Parent bd4a08d4865af170a508d931fdac97860a0b104c (byte-compile-defmacro-declaration): New fun. (byte-compile-file-form-defmumble, byte-compile-defmacro): Use it. (byte-compile-defmacro): Use backquotes. diff -r bd4a08d4865a -r 507e3735eed8 lisp/ChangeLog --- a/lisp/ChangeLog Thu Oct 01 04:31:40 2009 +0000 +++ b/lisp/ChangeLog Thu Oct 01 04:38:52 2009 +0000 @@ -1,5 +1,9 @@ 2009-10-01 Stefan Monnier + * emacs-lisp/bytecomp.el (byte-compile-defmacro-declaration): New fun. + (byte-compile-file-form-defmumble, byte-compile-defmacro): Use it. + (byte-compile-defmacro): Use backquotes. + * files.el (cd-absolute): Don't abbreviate-file-name (bug#4599). * vc-dispatcher.el (vc-resynch-window): Don't revert a buffer which diff -r bd4a08d4865a -r 507e3735eed8 lisp/emacs-lisp/bytecomp.el --- a/lisp/emacs-lisp/bytecomp.el Thu Oct 01 04:31:40 2009 +0000 +++ b/lisp/emacs-lisp/bytecomp.el Thu Oct 01 04:38:52 2009 +0000 @@ -2429,6 +2429,24 @@ (defun byte-compile-file-form-defmacro (form) (byte-compile-file-form-defmumble form t)) +(defun byte-compile-defmacro-declaration (form) + "Generate code for declarations in macro definitions. +Remove declarations from the body of the macro definition +by side-effects." + (let ((tail (nthcdr 2 form)) + (res '())) + (when (stringp (car (cdr tail))) + (setq tail (cdr tail))) + (while (and (consp (car (cdr tail))) + (eq (car (car (cdr tail))) 'declare)) + (let ((declaration (car (cdr tail)))) + (setcdr tail (cdr (cdr tail))) + (push `(if macro-declaration-function + (funcall macro-declaration-function + ',(car (cdr form)) ',declaration)) + res))) + res)) + (defun byte-compile-file-form-defmumble (form macrop) (let* ((bytecomp-name (car (cdr form))) (bytecomp-this-kind (if macrop 'byte-compile-macro-environment @@ -2498,17 +2516,8 @@ ;; Generate code for declarations in macro definitions. ;; Remove declarations from the body of the macro definition. (when macrop - (let ((tail (nthcdr 2 form))) - (when (stringp (car (cdr tail))) - (setq tail (cdr tail))) - (while (and (consp (car (cdr tail))) - (eq (car (car (cdr tail))) 'declare)) - (let ((declaration (car (cdr tail)))) - (setcdr tail (cdr (cdr tail))) - (prin1 `(if macro-declaration-function - (funcall macro-declaration-function - ',bytecomp-name ',declaration)) - bytecomp-outbuffer))))) + (dolist (decl (byte-compile-defmacro-declaration form)) + (prin1 decl bytecomp-outbuffer))) (let* ((new-one (byte-compile-lambda (nthcdr 2 form) t)) (code (byte-compile-byte-code-maker new-one))) @@ -4003,13 +4012,15 @@ (defun byte-compile-defmacro (form) ;; This is not used for file-level defmacros with doc strings. (byte-compile-body-do-effect - (list (list 'fset (list 'quote (nth 1 form)) - (let ((code (byte-compile-byte-code-maker - (byte-compile-lambda (cdr (cdr form)) t)))) - (if (eq (car-safe code) 'make-byte-code) - (list 'cons ''macro code) - (list 'quote (cons 'macro (eval code)))))) - (list 'quote (nth 1 form))))) + (let ((decls (byte-compile-defmacro-declaration form)) + (code (byte-compile-byte-code-maker + (byte-compile-lambda (cdr (cdr form)) t)))) + `((defalias ',(nth 1 form) + ,(if (eq (car-safe code) 'make-byte-code) + `(cons 'macro ,code) + `'(macro . ,(eval code)))) + ,@decls + ',(nth 1 form))))) (defun byte-compile-defvar (form) ;; This is not used for file-level defvar/consts with doc strings.