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:
Stefan Monnier 2012-09-04 13:40:25 -04:00
parent 1088b9226e
commit 972debf2e7
10 changed files with 206 additions and 69 deletions

View file

@ -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'.

View file

@ -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".

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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))

View file

@ -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")

View file

@ -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).

View file

@ -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 \

View file

@ -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)