(byte-compile-defmacro-declaration): New fun.

(byte-compile-file-form-defmumble, byte-compile-defmacro): Use it.
(byte-compile-defmacro): Use backquotes.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 552ee4538b5bcfca0888d78bd44494ccac78348a..9a0a42f662eecc853dffc6421693fbef6e810e64 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,9 @@
 2009-10-01  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+       * 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 --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 7903bf6a1d92c73cbbc0c2e0bcdcbc99bd0345cb..79e0885137ba2bf45e259cc0ce6f433bd8cede9a 100644 (file)
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2429,6 +2429,24 @@ list that represents a doc string reference.
 (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 @@ list that represents a doc string reference.
     ;; 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 @@ that suppresses all warnings during execution of BODY."
 (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.