From 57a7d50707c79e22f52a71d9c7f6d4a4773456c3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 5 Jun 2012 11:41:12 -0400 Subject: [PATCH] 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. --- lisp/ChangeLog | 18 ++++++++++++-- lisp/emacs-lisp/byte-opt.el | 18 +++++++------- lisp/emacs-lisp/bytecomp.el | 14 +++++------ lisp/emacs-lisp/cl-lib.el | 5 ++++ lisp/emacs-lisp/cl-macs.el | 29 ++++++++++------------ lisp/emacs-lisp/cl.el | 6 ++--- lisp/emacs-lisp/macroexp.el | 48 +++++++++++++++++++++++-------------- 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 + + 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 * 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 -- 2.39.2