Add native compiler-macro support.

* lisp/emacs-lisp/macroexp.el (macroexpand-all-1):
Support compiler-macros directly.  Properly follow aliases and apply
the compiler macros more thoroughly.
* lisp/emacs-lisp/cl.el: Don't copy compiler-macro properties any more since
macroexpand now properly follows aliases.
* lisp/emacs-lisp/cl-macs.el (toplevel, cl-define-compiler-macro)
(cl-compiler-macroexpand): Use new prop.
* lisp/emacs-lisp/byte-opt.el (featurep): Optimize earlier.
* lisp/emacs-lisp/cl-lib.el (custom-print-functions): Add compatibility alias.

7 files changed, 80 insertions, 58 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9577d902a2d..38c4c74dab7 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,17 @@
+2012-06-05  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        Add native compiler-macro support.
+        * emacs-lisp/macroexp.el (macroexpand-all-1):
+        Support compiler-macros directly.  Properly follow aliases and apply
+        the compiler macros more thoroughly.
+        * emacs-lisp/cl.el: Don't copy compiler-macro properties any more since
+        macroexpand now properly follows aliases.
+        * emacs-lisp/cl-macs.el (toplevel, cl-define-compiler-macro)
+        (cl-compiler-macroexpand): Use new prop.
+        * emacs-lisp/byte-opt.el (featurep): Optimize earlier.
+
+        * emacs-lisp/cl-lib.el (custom-print-functions): Add alias.
+
 2012-06-05  Martin Rudalics  <rudalics@gmx.at>
 
         * window.el (get-lru-window, get-mru-window, get-largest-window):
@@ -5,8 +19,8 @@
         (window--display-buffer-1, window--display-buffer-2): Replace by
         new function window--display-buffer
         (display-buffer-same-window, display-buffer-reuse-window)
-        (display-buffer-pop-up-frame, display-buffer-pop-up-window): Use
-        window--display-buffer.
+        (display-buffer-pop-up-frame, display-buffer-pop-up-window):
+        Use window--display-buffer.
         (display-buffer-use-some-window): Remove temporary dedication
         hack by calling get-lru-window and get-largest-window with
         NOT-SELECTED argument non-nil.  Call window--display-buffer.
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 7cb93890cb5..117e837f47f 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1159,15 +1159,15 @@
 ;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
 ;; string-make-multibyte for constant args.
 
-(put 'featurep 'byte-optimizer 'byte-optimize-featurep)
-(defun byte-optimize-featurep (form)
-  ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so we
-  ;; can safely optimize away this test.
-  (if (member (cdr-safe form) '(((quote xemacs)) ((quote sxemacs))))
-      nil
-    (if (member (cdr-safe form) '(((quote emacs))))
-        t
-      form)))
+(put 'featurep 'compiler-macro
+     (lambda (form &rest _ignore)
+       ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so
+       ;; we can safely optimize away this test.
+       (if (member (cdr-safe form) '(((quote xemacs)) ((quote sxemacs))))
+           nil
+         (if (member (cdr-safe form) '(((quote emacs))))
+             t
+           form))))
 
 (put 'set 'byte-optimizer 'byte-optimize-set)
 (defun byte-optimize-set (form)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index bf6237cb120..c5f5faec765 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2874,14 +2874,12 @@ That command is designed for interactive use only" fn))
             (byte-compile-log-warning
              (format "Forgot to expand macro %s" (car form)) nil :error))
         (if (and handler
-                 ;; Make sure that function exists.  This is important
-                 ;; for CL compiler macros since the symbol may be
-                 ;; `cl-byte-compile-compiler-macro' but if CL isn't
-                 ;; loaded, this function doesn't exist.
-                 (and (not (eq handler
-                               ;; Already handled by macroexpand-all.
-                               'cl-byte-compile-compiler-macro))
-                      (functionp handler)))
+                 ;; Make sure that function exists.
+                 (and (functionp handler)
+                      ;; Ignore obsolete byte-compile function used by former
+                      ;; CL code to handle compiler macros (we do it
+                      ;; differently now).
+                      (not (eq handler 'cl-byte-compile-compiler-macro))))
             (funcall handler form)
           (byte-compile-normal-call form))
         (if (byte-compile-warning-enabled-p 'cl-functions)
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 0dd8c9e1569..d70a98c1bc6 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -94,6 +94,11 @@
 (defvar cl-optimize-speed 1)
 (defvar cl-optimize-safety 1)
 
+;;;###autoload
+(define-obsolete-variable-alias
+  ;; This alias is needed for compatibility with .elc files that use defstruct
+  ;; and were compiled with Emacs<24.2.
+  'custom-print-functions 'cl-custom-print-functions "24.2")
 
 ;;;###autoload
 (defvar cl-custom-print-functions nil
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index e1488ea0db4..cf5282fd8d6 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2922,28 +2922,24 @@ and then returning foo."
     (setq args (nconc (nreverse res) (and p (list '&rest p)))))
   `(cl-eval-when (compile load eval)
      ,(cl-transform-function-property
-       func 'cl-compiler-macro
+       func 'compiler-macro
        (cons (if (memq '&whole args) (delq '&whole args)
                (cons '_cl-whole-arg args)) body))
-     (or (get ',func 'byte-compile)
-         (progn
-           (put ',func 'byte-compile
-                'cl-byte-compile-compiler-macro)
-           ;; This is so that describe-function can locate
-           ;; the macro definition.
-           (let ((file ,(or buffer-file-name
-                            (and (boundp 'byte-compile-current-file)
-                                 (stringp byte-compile-current-file)
-                                 byte-compile-current-file))))
-             (if file (put ',func 'compiler-macro-file
-                           (purecopy (file-name-nondirectory file)))))))))
+     ;; This is so that describe-function can locate
+     ;; the macro definition.
+     (let ((file ,(or buffer-file-name
+                      (and (boundp 'byte-compile-current-file)
+                           (stringp byte-compile-current-file)
+                           byte-compile-current-file))))
+       (if file (put ',func 'compiler-macro-file
+                     (purecopy (file-name-nondirectory file)))))))
 
 ;;;###autoload
 (defun cl-compiler-macroexpand (form)
   (while
       (let ((func (car-safe form)) (handler nil))
         (while (and (symbolp func)
-                    (not (setq handler (get func 'cl-compiler-macro)))
+                    (not (setq handler (get func 'compiler-macro)))
                     (fboundp func)
                     (or (not (eq (car-safe (symbol-function func)) 'autoload))
                         (load (nth 1 (symbol-function func)))))
@@ -3106,9 +3102,8 @@ surrounded by (cl-block NAME ...).
 
 (mapc (lambda (y)
         (put (car y) 'side-effect-free t)
-        (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro)
-        (put (car y) 'cl-compiler-macro
-             `(lambda (w x)
+        (put (car y) 'compiler-macro
+             `(lambda (_w x)
                 ,(if (symbolp (cadr y))
                      `(list ',(cadr y)
                             (list ',(cl-caddr y) x))
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 3b83a713402..14eb15fa578 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -321,13 +321,11 @@
                (intern (format "cl-%s" fun)))))
     (defalias fun new)
     ;; If `cl-foo' is declare inline, then make `foo' inline as well, and
-    ;; similarly, if `cl-foo' has a compiler-macro, make it available for `foo'
-    ;; as well.  Same for edebug specifications, indent rules and
+    ;; similarly.  Same for edebug specifications, indent rules and
     ;; doc-string position.
     ;; FIXME: For most of them, we should instead follow aliases
     ;; where applicable.
-    (dolist (prop '(byte-optimizer byte-compile cl-compiler-macro
-                    doc-string-elt edebug-form-spec
+    (dolist (prop '(byte-optimizer doc-string-elt edebug-form-spec
                     lisp-indent-function))
       (if (get new prop)
         (put fun prop (get new prop))))))
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index be51b5c3dd3..953b4b7eab5 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -177,25 +177,37 @@ Assumes the caller has bound `macroexpand-all-environment'."
                    (cons (macroexpand-all-1
                           (list 'function f))
                          (macroexpand-all-forms args)))))
-      ;; Macro expand compiler macros.  This cannot be delayed to
-      ;; byte-optimize-form because the output of the compiler-macro can
-      ;; use macros.
-      ;; FIXME: Don't depend on CL.
-      (`(,(pred (lambda (fun)
-                  (and (symbolp fun)
-                       (eq (get fun 'byte-compile)
-                           'cl-byte-compile-compiler-macro)
-                       (functionp 'cl-compiler-macroexpand))))
-         . ,_)
-       (let ((newform (with-no-warnings (cl-compiler-macroexpand form))))
-         (if (eq form newform)
+      (`(,func . ,_)
+       ;; Macro expand compiler macros.  This cannot be delayed to
+       ;; byte-optimize-form because the output of the compiler-macro can
+       ;; use macros.
+       (let ((handler nil))
+         (while (and (symbolp func)
+                     (not (setq handler (get func 'compiler-macro)))
+                     (fboundp func)
+                     (or (not (eq (car-safe (symbol-function func))
+                                  'autoload))
+                         (load (nth 1 (symbol-function func)))))
+           ;; Follow the sequence of aliases.
+           (setq func (symbol-function func)))
+         (if (null handler)
+             ;; No compiler macro.  We just expand each argument (for
+             ;; setq/setq-default this works alright because the variable names
+             ;; are symbols).
              (macroexpand-all-forms form 1)
-           (macroexpand-all-1 newform))))
-      (`(,_ . ,_)
-       ;; For every other list, we just expand each argument (for
-       ;; setq/setq-default this works alright because the variable names
-       ;; are symbols).
-       (macroexpand-all-forms form 1))
+           (let ((newform (apply handler form (cdr form))))
+             (if (eq form newform)
+                 ;; The compiler macro did not find anything to do.
+                 (if (equal form (setq newform (macroexpand-all-forms form 1)))
+                     form
+                   ;; Maybe after processing the args, some new opportunities
+                   ;; appeared, so let's try the compiler macro again.
+                   (if (eq newform
+                           (setq form (apply handler newform (cdr newform))))
+                       newform
+                     (macroexpand-all-1 newform)))
+               (macroexpand-all-1 newform))))))
+
       (t form))))
 
 ;;;###autoload