mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-03 08:30:09 +00:00
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.
This commit is contained in:
Stefan Monnier
parent
51a5f9d816
commit
57a7d50707
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user