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.

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.

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

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

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.

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.  */

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

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,7 +1953,8 @@ readevalloop (Lisp_Object readcharfun,
 
       /* Now eval what we just read.  */
       if (!NILP (macroexpand))
-	val = call1 (macroexpand, val);
+        val = readevalloop_eager_expand_eval (val, macroexpand);
+      else
         val = eval_sub (val);
 
       if (printflag)

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>
 

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))
+           (if compile
                (let ((byte-compile-dest-file elcfile))
-             (byte-compile-file elfile t)))
+                 (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: