Commit 57a7d507 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

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.
parent 51a5f9d8
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.
......
......@@ -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)
......
......@@ -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)
......
......@@ -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
......
......@@ -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))
......
......@@ -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))))))
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment