[Emacs-diffs] trunk r117010: Correctly macroexpand top-level forms during eager macroexpand

[Daniel Colascione]

------------------------------------------------------------
revno: 117010
revision-id: address@hidden
parent: address@hidden
committer: Daniel Colascione <address@hidden>
branch nick: trunk
timestamp: Tue 2014-04-22 00:04:34 -0700
message:
  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.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/emacs-lisp/byte-run.el    byterun.el-20091113204419-o5vbwnq5f7feedwu-2586
  lisp/emacs-lisp/macroexp.el    
macroexp.el-20091113204419-o5vbwnq5f7feedwu-2966
  src/ChangeLog                  changelog-20091113204419-o5vbwnq5f7feedwu-1438
  src/callint.c                  callint.c-20091113204419-o5vbwnq5f7feedwu-279
  src/lisp.h                     lisp.h-20091113204419-o5vbwnq5f7feedwu-253
  src/lread.c                    lread.c-20091113204419-o5vbwnq5f7feedwu-266
  test/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-8588
  test/automated/bytecomp-tests.el 
bytecomptestsuite.el-20091113204419-o5vbwnq5f7feedwu-8799

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-04-22 06:51:30 +0000
+++ b/lisp/ChangeLog    2014-04-22 07:04:34 +0000
@@ -1,5 +1,12 @@
 2014-04-22  Daniel Colascione  <address@hidden>
 
+       * 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.

=== modified file 'lisp/emacs-lisp/byte-run.el'
--- a/lisp/emacs-lisp/byte-run.el       2014-03-22 22:12:52 +0000
+++ b/lisp/emacs-lisp/byte-run.el       2014-04-22 07:04:34 +0000
@@ -398,13 +398,20 @@
 
 (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

=== modified file 'lisp/emacs-lisp/macroexp.el'
--- a/lisp/emacs-lisp/macroexp.el       2014-04-21 09:34:21 +0000
+++ b/lisp/emacs-lisp/macroexp.el       2014-04-22 07:04:34 +0000
@@ -405,7 +405,7 @@
 (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 @@
     (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

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2014-04-19 20:32:05 +0000
+++ b/src/ChangeLog     2014-04-22 07:04:34 +0000
@@ -1,3 +1,11 @@
+2014-04-22  Daniel Colascione  <address@hidden>
+
+       * 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  <address@hidden>
 
        * intervals.c (rotate_right, rotate_left): Fix up length computation.

=== modified file 'src/callint.c'
--- a/src/callint.c     2014-01-31 09:41:54 +0000
+++ b/src/callint.c     2014-04-22 07:04:34 +0000
@@ -38,8 +38,8 @@
 
 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.  */

=== modified file 'src/lisp.h'
--- a/src/lisp.h        2014-04-16 19:43:46 +0000
+++ b/src/lisp.h        2014-04-22 07:04:34 +0000
@@ -4027,6 +4027,7 @@
 /* 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);

=== modified file 'src/lread.c'
--- a/src/lread.c       2014-02-25 22:51:34 +0000
+++ b/src/lread.c       2014-04-22 07:04:34 +0000
@@ -1763,6 +1763,29 @@
   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 @@
 
       /* 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)
        {

=== modified file 'test/ChangeLog'
--- a/test/ChangeLog    2014-04-22 03:51:12 +0000
+++ b/test/ChangeLog    2014-04-22 07:04:34 +0000
@@ -1,7 +1,19 @@
 2014-04-22  Daniel Colascione  <address@hidden>
 
+       * 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  <address@hidden>
 

=== modified file 'test/automated/bytecomp-tests.el'
--- a/test/automated/bytecomp-tests.el  2014-04-21 09:34:21 +0000
+++ b/test/automated/bytecomp-tests.el  2014-04-22 07:04:34 +0000
@@ -305,30 +305,33 @@
                            '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 @@
   ;; 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,12 +352,47 @@
   ;; 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
-    '(require 'cl-lib)
-    '(cl-macrolet ((m () 4))
-      (defmacro m () 5)
-      (defun def () (m))))
-  (should (equal (funcall 'def) 4)))
+  (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