From 12b1389c9039dd374951673ca43b1ddf65df400d Mon Sep 17 00:00:00 2001 From: Daniel Colascione Date: Tue, 22 Apr 2014 00:04:34 -0700 Subject: [PATCH] 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 | 7 ++++ lisp/emacs-lisp/byte-run.el | 13 ++++++-- lisp/emacs-lisp/macroexp.el | 6 ++-- src/ChangeLog | 8 +++++ src/callint.c | 4 +-- src/lisp.h | 1 + src/lread.c | 28 ++++++++++++++-- test/ChangeLog | 14 +++++++- test/automated/bytecomp-tests.el | 56 +++++++++++++++++++++++++++----- 9 files changed, 118 insertions(+), 19 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 38871c7ff3..06e2732bec 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,12 @@ 2014-04-22 Daniel Colascione + * 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 dc08b87056..be011e2146 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 c2bfc891b7..44727daf76 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 bb05be04d3..bb2e2bad55 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,11 @@ +2014-04-22 Daniel Colascione + + * 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 * intervals.c (rotate_right, rotate_left): Fix up length computation. diff --git a/src/callint.c b/src/callint.c index 35411bf9b5..54f04cdee1 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 6ef0f83aea..4c310f6966 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 4990d25eda..4edd1177fb 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 1163402fd1..1caf0b3eb8 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,7 +1,19 @@ 2014-04-22 Daniel Colascione + * 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 diff --git a/test/automated/bytecomp-tests.el b/test/automated/bytecomp-tests.el index e61c7c3a41..a7fbdbe2e7 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: -- 2.20.1