[Emacs-diffs] /srv/bzr/emacs/trunk r108485: Add native compiler-macro support.

[Stefan Monnier]

------------------------------------------------------------
revno: 108485
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2012-06-05 11:41:12 -0400
message:
  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.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/byte-opt.el
  lisp/emacs-lisp/bytecomp.el
  lisp/emacs-lisp/cl-lib.el
  lisp/emacs-lisp/cl-macs.el
  lisp/emacs-lisp/cl.el
  lisp/emacs-lisp/macroexp.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-06-05 09:11:06 +0000
+++ b/lisp/ChangeLog    2012-06-05 15:41:12 +0000
@@ -1,3 +1,17 @@
+2012-06-05  Stefan Monnier  <address@hidden>
+
+       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  <address@hidden>
 
        * 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.

=== modified file 'lisp/emacs-lisp/byte-opt.el'
--- a/lisp/emacs-lisp/byte-opt.el       2012-05-30 03:59:42 +0000
+++ b/lisp/emacs-lisp/byte-opt.el       2012-06-05 15:41:12 +0000
@@ -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)

=== modified file 'lisp/emacs-lisp/bytecomp.el'
--- a/lisp/emacs-lisp/bytecomp.el       2012-06-01 19:47:54 +0000
+++ b/lisp/emacs-lisp/bytecomp.el       2012-06-05 15:41:12 +0000
@@ -2874,14 +2874,12 @@
             (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)

=== modified file 'lisp/emacs-lisp/cl-lib.el'
--- a/lisp/emacs-lisp/cl-lib.el 2012-06-04 14:08:33 +0000
+++ b/lisp/emacs-lisp/cl-lib.el 2012-06-05 15:41:12 +0000
@@ -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

=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- a/lisp/emacs-lisp/cl-macs.el        2012-06-04 01:05:17 +0000
+++ b/lisp/emacs-lisp/cl-macs.el        2012-06-05 15:41:12 +0000
@@ -2922,28 +2922,24 @@
     (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 @@
 
 (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))

=== modified file 'lisp/emacs-lisp/cl.el'
--- a/lisp/emacs-lisp/cl.el     2012-06-04 01:05:17 +0000
+++ b/lisp/emacs-lisp/cl.el     2012-06-05 15:41:12 +0000
@@ -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))))))

=== modified file 'lisp/emacs-lisp/macroexp.el'
--- a/lisp/emacs-lisp/macroexp.el       2012-06-04 01:05:17 +0000
+++ b/lisp/emacs-lisp/macroexp.el       2012-06-05 15:41:12 +0000
@@ -177,25 +177,37 @@
                    (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