Correctly macroexpand top-level forms during eager macroexpand

* lisp/emacs-lisp/byte-run.el (eval-when-compile, eval-and-compile):
Improve docstrings.

* lisp/emacs-lisp/macroexp.el (internal-macroexpand-for-load): Add
`full-p' parameter; when nil, call `macroexpand' instead of
`macroexpand-all'.

* src/lread.c (readevalloop_eager_expand_eval): New function
that can recurse into toplevel forms.
(readevalloop): Call it.
* src/lisp.h: Declare Qprogn.
* src/callint.c (Qprogn): No longer static.

* test/automated/bytecomp-tests.el (test-byte-comp-compile-and-load):
Add compile flag.
(test-byte-comp-macro-expansion)
(test-byte-comp-macro-expansion-eval-and-compile)
(test-byte-comp-macro-expansion-eval-when-compile)
(test-byte-comp-macro-expand-lexical-override): Use it.
(test-eager-load-macro-expansion)
(test-eager-load-macro-expansion-eval-and-compile)
(test-eager-load-macro-expansion-eval-when-compile)
(test-eager-load-macro-expand-lexical-override): New tests.

9 files changed, 118 insertions, 19 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 38871c7ff32..06e2732becc 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,12 @@
 2014-04-22  Daniel Colascione  <dancol@dancol.org>
 
+        * emacs-lisp/macroexp.el (internal-macroexpand-for-load): Add
+        `full-p' parameter; when nil, call `macroexpand' instead of
+        `macroexpand-all'.
+
+        * emacs-lisp/byte-run.el (eval-when-compile, eval-and-compile):
+        Improve docstrings.
+
         * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment):
         Use lambda function values, not quoted lambdas.
         (byte-compile-recurse-toplevel): Remove extraneous &optional.
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index dc08b870569..be011e2146c 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -398,13 +398,20 @@ If you think you need this, you're probably making a mistake somewhere."
 
 (defmacro eval-when-compile (&rest body)
   "Like `progn', but evaluates the body at compile time if you're compiling.
-Thus, the result of the body appears to the compiler as a quoted constant.
-In interpreted code, this is entirely equivalent to `progn'."
+Thus, the result of the body appears to the compiler as a quoted
+constant.  In interpreted code, this is entirely equivalent to
+`progn', except that the value of the expression may be (but is
+not necessarily) computed at load time if eager macro expansion
+is enabled."
   (declare (debug (&rest def-form)) (indent 0))
   (list 'quote (eval (cons 'progn body) lexical-binding)))
 
 (defmacro eval-and-compile (&rest body)
-  "Like `progn', but evaluates the body at compile time and at load time."
+  "Like `progn', but evaluates the body at compile time and at
+load time.  In interpreted code, this is entirely equivalent to
+`progn', except that the value of the expression may be (but is
+not necessarily) computed at load time if eager macro expansion
+is enabled."
   (declare (debug t) (indent 0))
   ;; When the byte-compiler expands code, this macro is not used, so we're
   ;; either about to run `body' (plain interpretation) or we're doing eager
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index c2bfc891b72..44727daf76a 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -405,7 +405,7 @@ symbol itself."
 (defvar macroexp--pending-eager-loads nil
   "Stack of files currently undergoing eager macro-expansion.")
 
-(defun internal-macroexpand-for-load (form)
+(defun internal-macroexpand-for-load (form full-p)
   ;; Called from the eager-macroexpansion in readevalloop.
   (cond
    ;; Don't repeat the same warning for every top-level element.
@@ -428,7 +428,9 @@ symbol itself."
     (condition-case err
         (let ((macroexp--pending-eager-loads
                (cons load-file-name macroexp--pending-eager-loads)))
-          (macroexpand-all form))
+          (if full-p
+              (macroexpand-all form)
+            (macroexpand 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
diff --git a/src/ChangeLog b/src/ChangeLog
index bb05be04d3e..bb2e2bad555 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+2014-04-22  Daniel Colascione  <dancol@dancol.org>
+
+        * lread.c (readevalloop_eager_expand_eval): New function
+        that can recurse into toplevel forms.
+        (readevalloop): Call it.
+        * lisp.h: Declare Qprogn.
+        * callint.c (Qprogn): No longer static.
+
 2014-04-19  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * intervals.c (rotate_right, rotate_left): Fix up length computation.
diff --git a/src/callint.c b/src/callint.c
index 35411bf9b5c..54f04cdee17 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -38,8 +38,8 @@ static Lisp_Object Qread_number;
 
 Lisp_Object Qmouse_leave_buffer_hook;
 
-static Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif;
-Lisp_Object Qwhen;
+static Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qif;
+Lisp_Object Qwhen, Qprogn;
 static Lisp_Object preserved_fns;
 
 /* Marker used within call-interactively to refer to point.  */
diff --git a/src/lisp.h b/src/lisp.h
index 6ef0f83aea4..4c310f69662 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4027,6 +4027,7 @@ extern void syms_of_minibuf (void);
 /* Defined in callint.c.  */
 
 extern Lisp_Object Qminus, Qplus;
+extern Lisp_Object Qprogn;
 extern Lisp_Object Qwhen;
 extern Lisp_Object Qmouse_leave_buffer_hook;
 extern void syms_of_callint (void);
diff --git a/src/lread.c b/src/lread.c
index 4990d25eda1..4edd1177fb4 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1763,6 +1763,29 @@ end_of_file_error (void)
   xsignal0 (Qend_of_file);
 }
 
+static Lisp_Object
+readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand)
+{
+  /* If we macroexpand the toplevel form non-recursively and it ends
+     up being a `progn' (or if it was a progn to start), treat each
+     form in the progn as a top-level form.  This way, if one form in
+     the progn defines a macro, that macro is in effect when we expand
+     the remaining forms.  See similar code in bytecomp.el.  */
+  val = call2 (macroexpand, val, Qnil);
+  if (EQ (CAR_SAFE (val), Qprogn))
+    {
+      Lisp_Object subforms = XCDR (val);
+      val = Qnil;
+      for (; CONSP (subforms); subforms = XCDR (subforms))
+          val = readevalloop_eager_expand_eval (XCAR (subforms),
+                                                macroexpand);
+    }
+  else
+      val = eval_sub (call2 (macroexpand, val, Qt));
+
+  return val;
+}
+
 /* UNIBYTE specifies how to set load_convert_to_unibyte
    for this invocation.
    READFUN, if non-nil, is used instead of `read'.
@@ -1930,8 +1953,9 @@ readevalloop (Lisp_Object readcharfun,
 
       /* Now eval what we just read.  */
       if (!NILP (macroexpand))
-        val = call1 (macroexpand, val);
-      val = eval_sub (val);
+        val = readevalloop_eager_expand_eval (val, macroexpand);
+      else
+        val = eval_sub (val);
 
       if (printflag)
         {
diff --git a/test/ChangeLog b/test/ChangeLog
index 1163402fd19..1caf0b3eb85 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,7 +1,19 @@
 2014-04-22  Daniel Colascione  <dancol@dancol.org>
 
+        * automated/bytecomp-tests.el (test-byte-comp-compile-and-load):
+        Add compile flag.
+        (test-byte-comp-macro-expansion)
+        (test-byte-comp-macro-expansion-eval-and-compile)
+        (test-byte-comp-macro-expansion-eval-when-compile)
+        (test-byte-comp-macro-expand-lexical-override): Use it.
+        (test-eager-load-macro-expansion)
+        (test-eager-load-macro-expansion-eval-and-compile)
+        (test-eager-load-macro-expansion-eval-when-compile)
+        (test-eager-load-macro-expand-lexical-override): New tests.
+
         * automated/cl-lib.el (cl-lib-struct-accessors): Fix test to
-        account for removal of `cl-struct-set-slot-value'.
+        account for removal of `cl-struct-set-slot-value'. Also, move
+        the defstruct to top level.
 
 2014-04-21  Daniel Colascione  <dancol@dancol.org>
 
diff --git a/test/automated/bytecomp-tests.el b/test/automated/bytecomp-tests.el
index e61c7c3a41d..a7fbdbe2e7f 100644
--- a/test/automated/bytecomp-tests.el
+++ b/test/automated/bytecomp-tests.el
@@ -305,30 +305,33 @@ Subtests signal errors if something goes wrong."
                             'face fail-face)))
       (insert "\n"))))
 
-(defun test-byte-comp-compile-and-load (&rest forms)
+(defun test-byte-comp-compile-and-load (compile &rest forms)
   (let ((elfile nil)
         (elcfile nil))
     (unwind-protect
          (progn
            (setf elfile (make-temp-file "test-bytecomp" nil ".el"))
-           (setf elcfile (make-temp-file "test-bytecomp" nil ".elc"))
+           (when compile
+             (setf elcfile (make-temp-file "test-bytecomp" nil ".elc")))
            (with-temp-buffer
              (dolist (form forms)
                (print form (current-buffer)))
              (write-region (point-min) (point-max) elfile))
-           (let ((byte-compile-dest-file elcfile))
-             (byte-compile-file elfile t)))
+           (if compile
+               (let ((byte-compile-dest-file elcfile))
+                 (byte-compile-file elfile t))
+             (load elfile)))
       (when elfile (delete-file elfile))
       (when elcfile (delete-file elcfile)))))
-(put 'test-byte-comp-compile-and-load 'lisp-indent-function 0)
+(put 'test-byte-comp-compile-and-load 'lisp-indent-function 1)
 
 (ert-deftest test-byte-comp-macro-expansion ()
-  (test-byte-comp-compile-and-load
+  (test-byte-comp-compile-and-load t
     '(progn (defmacro abc (arg) 1) (defun def () (abc 2))))
   (should (equal (funcall 'def) 1)))
 
 (ert-deftest test-byte-comp-macro-expansion-eval-and-compile ()
-  (test-byte-comp-compile-and-load
+  (test-byte-comp-compile-and-load t
     '(eval-and-compile (defmacro abc (arg) -1) (defun def () (abc 2))))
   (should (equal (funcall 'def) -1)))
 
@@ -336,7 +339,7 @@ Subtests signal errors if something goes wrong."
   ;; Make sure we interpret eval-when-compile forms properly.  CLISP
   ;; and SBCL interpreter eval-when-compile (well, the CL equivalent)
   ;; in the same way.
-  (test-byte-comp-compile-and-load
+  (test-byte-comp-compile-and-load t
     '(eval-when-compile
       (defmacro abc (arg) -10)
       (defun abc-1 () (abc 2)))
@@ -349,13 +352,48 @@ Subtests signal errors if something goes wrong."
   ;; macrolet since macrolet's is explicitly called out as being
   ;; equivalent to toplevel, but CLISP and SBCL both evaluate the form
   ;; this way, so we should too.
-  (test-byte-comp-compile-and-load
+  (test-byte-comp-compile-and-load t
     '(require 'cl-lib)
     '(cl-macrolet ((m () 4))
       (defmacro m () 5)
       (defun def () (m))))
   (should (equal (funcall 'def) 4)))
 
+(ert-deftest test-eager-load-macro-expansion ()
+  (test-byte-comp-compile-and-load nil
+    '(progn (defmacro abc (arg) 1) (defun def () (abc 2))))
+  (should (equal (funcall 'def) 1)))
+
+(ert-deftest test-eager-load-macro-expansion-eval-and-compile ()
+  (test-byte-comp-compile-and-load nil
+    '(eval-and-compile (defmacro abc (arg) -1) (defun def () (abc 2))))
+  (should (equal (funcall 'def) -1)))
+
+(ert-deftest test-eager-load-macro-expansion-eval-when-compile ()
+  ;; Make sure we interpret eval-when-compile forms properly.  CLISP
+  ;; and SBCL interpreter eval-when-compile (well, the CL equivalent)
+  ;; in the same way.
+  (test-byte-comp-compile-and-load nil
+    '(eval-when-compile
+      (defmacro abc (arg) -10)
+      (defun abc-1 () (abc 2)))
+    '(defmacro abc-2 () (abc-1))
+    '(defun def () (abc-2)))
+  (should (equal (funcall 'def) -10)))
+
+(ert-deftest test-eager-load-macro-expand-lexical-override ()
+  ;; Intuitively, one might expect the defmacro to override the
+  ;; macrolet since macrolet's is explicitly called out as being
+  ;; equivalent to toplevel, but CLISP and SBCL both evaluate the form
+  ;; this way, so we should too.
+  (test-byte-comp-compile-and-load nil
+    '(require 'cl-lib)
+    '(cl-macrolet ((m () 4))
+      (defmacro m () 5)
+      (defun def () (m))))
+  (should (equal (funcall 'def) 4)))
+
+
 ;; Local Variables:
 ;; no-byte-compile: t
 ;; End: