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.

10 files changed, 206 insertions, 69 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 16e078fa639..e4a612f6a9e 100644
--- a/etc/NEWS
+++ b/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'.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4707834fe6b..64dda45276c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -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".
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index 470ca17d3a0..7d70d22c9cd 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -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
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 9a59aa0c6db..aba412cc8f5 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -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
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 70eab149837..394225d697e 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -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
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 4aeed7e4d0e..09e47b69b91 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -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))
diff --git a/lisp/loadup.el b/lisp/loadup.el
index a460fcab339..d389427bafd 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -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")
diff --git a/src/ChangeLog b/src/ChangeLog
index 1dd307b16de..b2634c4fdc4 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -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).
diff --git a/src/lisp.mk b/src/lisp.mk
index 162d8819917..3d60e07dea3 100644
--- a/src/lisp.mk
+++ b/src/lisp.mk
@@ -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 \
diff --git a/src/lread.c b/src/lread.c
index c15c8da3f7b..4f3a93b16b4 100644
--- a/src/lread.c
+++ b/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)