Macro-expand interpreted code during load.
* src/lread.c (readevalloop): Call internal-macroexpand-for-load to perform eager (load-time) macro-expansion. * src/lisp.mk (lisp): Add macroexp. * lisp/loadup.el: Load macroexp. Remove hack. * lisp/emacs-lisp/macroexp.el (macroexp--eval-if-compile): New function. (macroexp--expand-all): Use it to get better warnings. (macroexp--backtrace, macroexp--trim-backtrace-frame) (internal-macroexpand-for-load): New functions. (macroexp--pending-eager-loads): New var. (emacs-startup-hook): New hack to replace one in loadup.el. * lisp/emacs-lisp/cl-macs.el (cl--compiler-macro-list*) (cl--compiler-macro-cXXr): Move to top, before they can be used. (cl-psetf): Simplify. (cl-defstruct): Add indent rule.
This commit is contained in:
parent
1088b9226e
commit
972debf2e7
10 changed files with 206 additions and 69 deletions
7
etc/NEWS
7
etc/NEWS
|
@ -601,6 +601,13 @@ are deprecated and will be removed eventually.
|
|||
|
||||
* Lisp changes in Emacs 24.3
|
||||
|
||||
** Interpreted files get eagerly macro-expanded during load.
|
||||
This can significantly speed up execution of non-byte-compiled code, but can
|
||||
also bump into harmless and previously unnoticed cyclic dependencies.
|
||||
These should not be fatal: they will simply cause the macro-calls to be left
|
||||
for later expansion (as before), but will also result in a warning describing
|
||||
the cycle.
|
||||
|
||||
** New minor mode `read-only-mode' to replace toggle-read-only (now obsolete).
|
||||
|
||||
** New functions `autoloadp' and `autoload-do-load'.
|
||||
|
|
|
@ -1,3 +1,17 @@
|
|||
2012-09-04 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* loadup.el: Load macroexp. Remove hack.
|
||||
* emacs-lisp/macroexp.el (macroexp--eval-if-compile): New function.
|
||||
(macroexp--expand-all): Use it to get better warnings.
|
||||
(macroexp--backtrace, macroexp--trim-backtrace-frame)
|
||||
(internal-macroexpand-for-load): New functions.
|
||||
(macroexp--pending-eager-loads): New var.
|
||||
(emacs-startup-hook): New hack to replace one in loadup.el.
|
||||
* emacs-lisp/cl-macs.el (cl--compiler-macro-list*)
|
||||
(cl--compiler-macro-cXXr): Move to top, before they can be used.
|
||||
(cl-psetf): Simplify.
|
||||
(cl-defstruct): Add indent rule.
|
||||
|
||||
2012-09-04 Lars Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* mail/smtpmail.el (smtpmail-send-it): Prefer the From: header
|
||||
|
@ -21,10 +35,8 @@
|
|||
(temp-buffer-window-show-hook): New hooks.
|
||||
(temp-buffer-window-setup, temp-buffer-window-show)
|
||||
(with-temp-buffer-window): New functions.
|
||||
(fit-window-to-buffer): Remove unused optional argument
|
||||
OVERRIDE.
|
||||
(special-display-popup-frame): Make sure the window used shows
|
||||
BUFFER.
|
||||
(fit-window-to-buffer): Remove unused optional argument OVERRIDE.
|
||||
(special-display-popup-frame): Make sure the window used shows BUFFER.
|
||||
|
||||
* help.el (temp-buffer-resize-mode): Fix doc-string.
|
||||
(resize-temp-buffer-window): New optional argument WINDOW.
|
||||
|
@ -166,8 +178,8 @@
|
|||
2012-08-29 Michael Albinus <michael.albinus@gmx.de>
|
||||
|
||||
* eshell/esh-ext.el (eshell-external-command): Do not examine
|
||||
remote shell scripts. See
|
||||
<https://bugs.launchpad.net/ubuntu/+source/emacs23/+bug/1035790>.
|
||||
remote shell scripts.
|
||||
See <https://bugs.launchpad.net/ubuntu/+source/emacs23/+bug/1035790>.
|
||||
|
||||
* net/tramp-sh.el (tramp-remote-path): Add "/sbin" and
|
||||
"/usr/local/sbin".
|
||||
|
|
|
@ -249,8 +249,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
|
|||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (cl--compiler-macro-cXXr cl--compiler-macro-list*
|
||||
;;;;;; cl--compiler-macro-adjoin cl-defsubst cl-compiler-macroexpand
|
||||
;;;### (autoloads (cl--compiler-macro-adjoin cl-defsubst cl-compiler-macroexpand
|
||||
;;;;;; cl-define-compiler-macro cl-assert cl-check-type cl-typep
|
||||
;;;;;; cl-deftype cl-defstruct cl-callf2 cl-callf cl-letf* cl-letf
|
||||
;;;;;; cl-rotatef cl-shiftf cl-remf cl-psetf cl-declare cl-the cl-locally
|
||||
|
@ -260,9 +259,20 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
|
|||
;;;;;; cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase
|
||||
;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
|
||||
;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
|
||||
;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "9676d5517e8b9246c09fe78984c68bef")
|
||||
;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*)
|
||||
;;;;;; "cl-macs" "cl-macs.el" "e09b4be5072a8b52d40af6e073876e76")
|
||||
;;; Generated autoloads from cl-macs.el
|
||||
|
||||
(autoload 'cl--compiler-macro-list* "cl-macs" "\
|
||||
|
||||
|
||||
\(fn FORM ARG &rest OTHERS)" nil nil)
|
||||
|
||||
(autoload 'cl--compiler-macro-cXXr "cl-macs" "\
|
||||
|
||||
|
||||
\(fn FORM X)" nil nil)
|
||||
|
||||
(autoload 'cl-gensym "cl-macs" "\
|
||||
Generate a new uninterned symbol.
|
||||
The name is made by appending a number to PREFIX, default \"G\".
|
||||
|
@ -659,6 +669,8 @@ value, that slot cannot be set via `setf'.
|
|||
|
||||
(put 'cl-defstruct 'doc-string-elt '2)
|
||||
|
||||
(put 'cl-defstruct 'lisp-indent-function '1)
|
||||
|
||||
(autoload 'cl-deftype "cl-macs" "\
|
||||
Define NAME as a new data type.
|
||||
The type name can then be used in `cl-typecase', `cl-check-type', etc.
|
||||
|
@ -722,16 +734,6 @@ surrounded by (cl-block NAME ...).
|
|||
|
||||
\(fn FORM A LIST &rest KEYS)" nil nil)
|
||||
|
||||
(autoload 'cl--compiler-macro-list* "cl-macs" "\
|
||||
|
||||
|
||||
\(fn FORM ARG &rest OTHERS)" nil nil)
|
||||
|
||||
(autoload 'cl--compiler-macro-cXXr "cl-macs" "\
|
||||
|
||||
|
||||
\(fn FORM X)" nil nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (cl-tree-equal cl-nsublis cl-sublis cl-nsubst-if-not
|
||||
|
|
|
@ -58,6 +58,33 @@
|
|||
|
||||
;;; Initialization.
|
||||
|
||||
;; Place compiler macros at the beginning, otherwise uses of the corresponding
|
||||
;; functions can lead to recursive-loads that prevent the calls from
|
||||
;; being optimized.
|
||||
|
||||
;;;###autoload
|
||||
(defun cl--compiler-macro-list* (_form arg &rest others)
|
||||
(let* ((args (reverse (cons arg others)))
|
||||
(form (car args)))
|
||||
(while (setq args (cdr args))
|
||||
(setq form `(cons ,(car args) ,form)))
|
||||
form))
|
||||
|
||||
;;;###autoload
|
||||
(defun cl--compiler-macro-cXXr (form x)
|
||||
(let* ((head (car form))
|
||||
(n (symbol-name (car form)))
|
||||
(i (- (length n) 2)))
|
||||
(if (not (string-match "c[ad]+r\\'" n))
|
||||
(if (and (fboundp head) (symbolp (symbol-function head)))
|
||||
(cl--compiler-macro-cXXr (cons (symbol-function head) (cdr form))
|
||||
x)
|
||||
(error "Compiler macro for cXXr applied to non-cXXr form"))
|
||||
(while (> i (match-beginning 0))
|
||||
(setq x (list (if (eq (aref n i) ?a) 'car 'cdr) x))
|
||||
(setq i (1- i)))
|
||||
x)))
|
||||
|
||||
;;; Some predicates for analyzing Lisp forms.
|
||||
;; These are used by various
|
||||
;; macro expanders to optimize the results in certain common cases.
|
||||
|
@ -1905,8 +1932,6 @@ See Info node `(cl)Declarations' for details."
|
|||
(cl-do-proclaim (pop specs) nil)))
|
||||
nil)
|
||||
|
||||
|
||||
|
||||
;;; The standard modify macros.
|
||||
|
||||
;; `setf' is now part of core Elisp, defined in gv.el.
|
||||
|
@ -1929,7 +1954,7 @@ before assigning any PLACEs to the corresponding values.
|
|||
(or p (error "Odd number of arguments to cl-psetf"))
|
||||
(pop p))
|
||||
(if simple
|
||||
`(progn (setf ,@args) nil)
|
||||
`(progn (setq ,@args) nil)
|
||||
(setq args (reverse args))
|
||||
(let ((expr `(setf ,(cadr args) ,(car args))))
|
||||
(while (setq args (cddr args))
|
||||
|
@ -2119,7 +2144,7 @@ one keyword is supported, `:read-only'. If this has a non-nil
|
|||
value, that slot cannot be set via `setf'.
|
||||
|
||||
\(fn NAME SLOTS...)"
|
||||
(declare (doc-string 2)
|
||||
(declare (doc-string 2) (indent 1)
|
||||
(debug
|
||||
(&define ;Makes top-level form not be wrapped.
|
||||
[&or symbolp
|
||||
|
@ -2597,14 +2622,6 @@ surrounded by (cl-block NAME ...).
|
|||
`(if (cl-member ,a ,list ,@keys) ,list (cons ,a ,list))
|
||||
form))
|
||||
|
||||
;;;###autoload
|
||||
(defun cl--compiler-macro-list* (_form arg &rest others)
|
||||
(let* ((args (reverse (cons arg others)))
|
||||
(form (car args)))
|
||||
(while (setq args (cdr args))
|
||||
(setq form `(cons ,(car args) ,form)))
|
||||
form))
|
||||
|
||||
(defun cl--compiler-macro-get (_form sym prop &optional def)
|
||||
(if def
|
||||
`(cl-getf (symbol-plist ,sym) ,prop ,def)
|
||||
|
@ -2616,21 +2633,6 @@ surrounded by (cl-block NAME ...).
|
|||
(cl--make-type-test temp (cl--const-expr-val type)))
|
||||
form))
|
||||
|
||||
;;;###autoload
|
||||
(defun cl--compiler-macro-cXXr (form x)
|
||||
(let* ((head (car form))
|
||||
(n (symbol-name (car form)))
|
||||
(i (- (length n) 2)))
|
||||
(if (not (string-match "c[ad]+r\\'" n))
|
||||
(if (and (fboundp head) (symbolp (symbol-function head)))
|
||||
(cl--compiler-macro-cXXr (cons (symbol-function head) (cdr form))
|
||||
x)
|
||||
(error "Compiler macro for cXXr applied to non-cXXr form"))
|
||||
(while (> i (match-beginning 0))
|
||||
(setq x (list (if (eq (aref n i) ?a) 'car 'cdr) x))
|
||||
(setq i (1- i)))
|
||||
x)))
|
||||
|
||||
(dolist (y '(cl-first cl-second cl-third cl-fourth
|
||||
cl-fifth cl-sixth cl-seventh
|
||||
cl-eighth cl-ninth cl-tenth
|
||||
|
|
|
@ -100,6 +100,17 @@ each clause."
|
|||
(error (message "Compiler-macro error for %S: %S" (car form) err)
|
||||
form)))
|
||||
|
||||
(defun macroexp--eval-if-compile (&rest _forms)
|
||||
"Pseudo function used internally by macroexp to delay warnings.
|
||||
The purpose is to delay warnings to bytecomp.el, so they can use things
|
||||
like `byte-compile-log-warning' to get better file-and-line-number data
|
||||
and also to avoid outputting the warning during normal execution."
|
||||
nil)
|
||||
(put 'macroexp--eval-if-compile 'byte-compile
|
||||
(lambda (form)
|
||||
(mapc (lambda (x) (funcall (eval x))) (cdr form))
|
||||
(byte-compile-constant nil)))
|
||||
|
||||
(defun macroexp--expand-all (form)
|
||||
"Expand all macros in FORM.
|
||||
This is an internal version of `macroexpand-all'.
|
||||
|
@ -112,14 +123,17 @@ Assumes the caller has bound `macroexpand-all-environment'."
|
|||
(macroexpand (macroexp--all-forms form 1)
|
||||
macroexpand-all-environment)
|
||||
;; Normal form; get its expansion, and then expand arguments.
|
||||
(let ((new-form (macroexpand form macroexpand-all-environment)))
|
||||
(when (and (not (eq form new-form)) ;It was a macro call.
|
||||
(car-safe form)
|
||||
(symbolp (car form))
|
||||
(get (car form) 'byte-obsolete-info)
|
||||
(fboundp 'byte-compile-warn-obsolete))
|
||||
(byte-compile-warn-obsolete (car form)))
|
||||
(setq form new-form))
|
||||
(let ((new-form
|
||||
(macroexpand form macroexpand-all-environment)))
|
||||
(setq form
|
||||
(if (and (not (eq form new-form)) ;It was a macro call.
|
||||
(car-safe form)
|
||||
(symbolp (car form))
|
||||
(get (car form) 'byte-obsolete-info))
|
||||
`(progn (macroexp--eval-if-compile
|
||||
(lambda () (byte-compile-warn-obsolete ',(car form))))
|
||||
,new-form)
|
||||
new-form)))
|
||||
(pcase form
|
||||
(`(cond . ,clauses)
|
||||
(macroexp--cons 'cond (macroexp--all-clauses clauses) form))
|
||||
|
@ -323,6 +337,86 @@ symbol itself."
|
|||
"Return non-nil if EXP can be copied without extra cost."
|
||||
(or (symbolp exp) (macroexp-const-p exp)))
|
||||
|
||||
;;; Load-time macro-expansion.
|
||||
|
||||
;; Because macro-expansion used to be more lazy, eager macro-expansion
|
||||
;; tends to bump into previously harmless/unnoticeable cyclic-dependencies.
|
||||
;; So, we have to delay macro-expansion like we used to when we detect
|
||||
;; such a cycle, and we also want to help coders resolve those cycles (since
|
||||
;; they can be non-obvious) by providing a usefully trimmed backtrace
|
||||
;; (hopefully) highlighting the problem.
|
||||
|
||||
(defun macroexp--backtrace ()
|
||||
"Return the Elisp backtrace, more recent frames first."
|
||||
(let ((bt ())
|
||||
(i 0))
|
||||
(while
|
||||
(let ((frame (backtrace-frame i)))
|
||||
(when frame
|
||||
(push frame bt)
|
||||
(setq i (1+ i)))))
|
||||
(nreverse bt)))
|
||||
|
||||
(defun macroexp--trim-backtrace-frame (frame)
|
||||
(pcase frame
|
||||
(`(,_ macroexpand (,head . ,_) . ,_) `(macroexpand (,head …)))
|
||||
(`(,_ internal-macroexpand-for-load (,head ,second . ,_) . ,_)
|
||||
(if (or (symbolp second)
|
||||
(and (eq 'quote (car-safe second))
|
||||
(symbolp (cadr second))))
|
||||
`(macroexpand-all (,head ,second …))
|
||||
'(macroexpand-all …)))
|
||||
(`(,_ load-with-code-conversion ,name . ,_)
|
||||
`(load ,(file-name-nondirectory name)))))
|
||||
|
||||
(defvar macroexp--pending-eager-loads nil
|
||||
"Stack of files currently undergoing eager macro-expansion.")
|
||||
|
||||
(defun internal-macroexpand-for-load (form)
|
||||
;; Called from the eager-macroexpansion in readevalloop.
|
||||
(cond
|
||||
;; Don't repeat the same warning for every top-level element.
|
||||
((eq 'skip (car macroexp--pending-eager-loads)) form)
|
||||
;; If we detect a cycle, skip macro-expansion for now, and output a warning
|
||||
;; with a trimmed backtrace.
|
||||
((and load-file-name (member load-file-name macroexp--pending-eager-loads))
|
||||
(let* ((bt (delq nil
|
||||
(mapcar #'macroexp--trim-backtrace-frame
|
||||
(macroexp--backtrace))))
|
||||
(elem `(load ,(file-name-nondirectory load-file-name)))
|
||||
(tail (member elem (cdr (member elem bt)))))
|
||||
(if tail (setcdr tail (list '…)))
|
||||
(if (eq (car-safe (car bt)) 'macroexpand-all) (setq bt (cdr bt)))
|
||||
(message "Warning: Eager macro-expansion skipped due to cycle:\n %s"
|
||||
(mapconcat #'prin1-to-string (nreverse bt) " => "))
|
||||
(push 'skip macroexp--pending-eager-loads)
|
||||
form))
|
||||
(t
|
||||
(condition-case err
|
||||
(let ((macroexp--pending-eager-loads
|
||||
(cons load-file-name macroexp--pending-eager-loads)))
|
||||
(macroexpand-all form))
|
||||
(error
|
||||
;; Hopefully this shouldn't happen thanks to the cycle detection,
|
||||
;; but in case it does happen, let's catch the error and give the
|
||||
;; code a chance to macro-expand later.
|
||||
(message "Eager macro-expansion failure: %S" err)
|
||||
form)))))
|
||||
|
||||
;; ¡¡¡ Big Ugly Hack !!!
|
||||
;; src/bootstrap-emacs is mostly used to compile .el files, so it needs
|
||||
;; macroexp, bytecomp, cconv, and byte-opt to be fast. Generally this is done
|
||||
;; by compiling those files first, but this only makes a difference if those
|
||||
;; files are not preloaded. But macroexp.el is preloaded so we reload it if
|
||||
;; the current version is interpreted and there's a compiled version available.
|
||||
(eval-when-compile
|
||||
(add-hook 'emacs-startup-hook
|
||||
(lambda ()
|
||||
(and (not (byte-code-function-p
|
||||
(symbol-function 'macroexpand-all)))
|
||||
(locate-library "macroexp.elc")
|
||||
(load "macroexp.elc")))))
|
||||
|
||||
(provide 'macroexp)
|
||||
|
||||
;;; macroexp.el ends here
|
||||
|
|
|
@ -60,6 +60,8 @@
|
|||
;; is in a loop, the repeated macro-expansion becomes terribly costly, so we
|
||||
;; memoize previous macro expansions to try and avoid recomputing them
|
||||
;; over and over again.
|
||||
;; FIXME: Now that macroexpansion is also performed when loading an interpreted
|
||||
;; file, this is not a real problem any more.
|
||||
(defconst pcase--memoize (make-hash-table :weakness 'key :test 'eq))
|
||||
;; (defconst pcase--memoize-1 (make-hash-table :test 'eq))
|
||||
;; (defconst pcase--memoize-2 (make-hash-table :weakness 'key :test 'equal))
|
||||
|
|
|
@ -102,6 +102,19 @@
|
|||
(setq load-source-file-function 'load-with-code-conversion)
|
||||
(load "files")
|
||||
|
||||
;; Load-time macro-expansion can only take effect after setting
|
||||
;; load-source-file-function because of where it is called in lread.c.
|
||||
(load "emacs-lisp/macroexp")
|
||||
(if (byte-code-function-p (symbol-function 'macroexpand-all))
|
||||
nil
|
||||
;; Since loaddefs is not yet loaded, macroexp's uses of pcase will simply
|
||||
;; fail until pcase is explicitly loaded. This also means that we have to
|
||||
;; disable eager macro-expansion while loading pcase.
|
||||
(let ((macroexp--pending-eager-loads '(skip)))
|
||||
(load "emacs-lisp/pcase"))
|
||||
;; Re-load macroexp so as to eagerly macro-expand its uses of pcase.
|
||||
(load "emacs-lisp/macroexp"))
|
||||
|
||||
(load "cus-face")
|
||||
(load "faces") ; after here, `defface' may be used.
|
||||
|
||||
|
@ -266,21 +279,6 @@
|
|||
;For other systems, you must edit ../src/Makefile.in.
|
||||
(load "site-load" t)
|
||||
|
||||
;; ¡¡¡ Big Ugly Hack !!!
|
||||
;; src/bootstrap-emacs is mostly used to compile .el files, so it needs
|
||||
;; macroexp, bytecomp, cconv, and byte-opt to be fast. Generally this is done
|
||||
;; by compiling those files first, but this only makes a difference if those
|
||||
;; files are not preloaded. As it so happens, macroexp.el tends to be
|
||||
;; accidentally preloaded in src/bootstrap-emacs because cl.el and cl-macs.el
|
||||
;; require it. So let's unload it here, if needed, to make sure the
|
||||
;; byte-compiled version is used.
|
||||
(if (or (not (fboundp 'macroexpand-all))
|
||||
(byte-code-function-p (symbol-function 'macroexpand-all)))
|
||||
nil
|
||||
(fmakunbound 'macroexpand-all)
|
||||
(setq features (delq 'macroexp features))
|
||||
(autoload 'macroexpand-all "macroexp"))
|
||||
|
||||
;; Determine which last version number to use
|
||||
;; based on the executables that now exist.
|
||||
(if (and (or (equal (nth 3 command-line-args) "dump")
|
||||
|
|
|
@ -1,3 +1,9 @@
|
|||
2012-09-04 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* lread.c (readevalloop): Call internal-macroexpand-for-load to perform
|
||||
eager (load-time) macro-expansion.
|
||||
* lisp.mk (lisp): Add macroexp.
|
||||
|
||||
2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
|
||||
|
||||
Simplify redefinition of 'abort' (Bug#12316).
|
||||
|
|
|
@ -65,6 +65,7 @@ lisp = \
|
|||
$(lispsource)/format.elc \
|
||||
$(lispsource)/bindings.elc \
|
||||
$(lispsource)/files.elc \
|
||||
$(lispsource)/emacs-lisp/macroexp.elc \
|
||||
$(lispsource)/cus-face.elc \
|
||||
$(lispsource)/faces.elc \
|
||||
$(lispsource)/button.elc \
|
||||
|
|
13
src/lread.c
13
src/lread.c
|
@ -1680,6 +1680,17 @@ readevalloop (Lisp_Object readcharfun,
|
|||
int whole_buffer = 0;
|
||||
/* 1 on the first time around. */
|
||||
int first_sexp = 1;
|
||||
Lisp_Object macroexpand = intern ("internal-macroexpand-for-load");
|
||||
|
||||
if (NILP (Ffboundp (macroexpand))
|
||||
/* Don't macroexpand in .elc files, since it should have been done
|
||||
already. We actually don't know whether we're in a .elc file or not,
|
||||
so we use circumstancial evidence: .el files normally go through
|
||||
Vload_source_file_function -> load-with-code-conversion
|
||||
-> eval-buffer. */
|
||||
|| EQ (readcharfun, Qget_file_char)
|
||||
|| EQ (readcharfun, Qget_emacs_mule_file_char))
|
||||
macroexpand = Qnil;
|
||||
|
||||
if (MARKERP (readcharfun))
|
||||
{
|
||||
|
@ -1809,6 +1820,8 @@ readevalloop (Lisp_Object readcharfun,
|
|||
unbind_to (count1, Qnil);
|
||||
|
||||
/* Now eval what we just read. */
|
||||
if (!NILP (macroexpand))
|
||||
val = call1 (macroexpand, val);
|
||||
val = eval_sub (val);
|
||||
|
||||
if (printflag)
|
||||
|
|
Loading…
Add table
Reference in a new issue