[Emacs-diffs] trunk r117002: Correctly treat progn contents as toplevel forms when byte compiling

[Daniel Colascione]

------------------------------------------------------------
revno: 117002
revision-id: address@hidden
parent: address@hidden
committer: Daniel Colascione <address@hidden>
branch nick: trunk
timestamp: Mon 2014-04-21 02:34:21 -0700
message:
  Correctly treat progn contents as toplevel forms when byte compiling
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/emacs-lisp/bytecomp.el    bytecomp.el-20091113204419-o5vbwnq5f7feedwu-492
  lisp/emacs-lisp/macroexp.el    
macroexp.el-20091113204419-o5vbwnq5f7feedwu-2966
  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-21 01:03:39 +0000
+++ b/lisp/ChangeLog    2014-04-21 09:34:21 +0000
@@ -1,5 +1,11 @@
 2014-04-21  Daniel Colascione  <address@hidden>
 
+       * emacs-lisp/bytecomp.el (byte-compile-recurse-toplevel): New
+       function.
+       (byte-compile-recurse-toplevel,
+       (byte-compile-initial-macro-environment,
+       (byte-compile-toplevel-file-form): Use it.
+
        * emacs-lisp/cl-macs.el:
        (cl--loop-let): Properly destructure `while' clauses.
 

=== modified file 'lisp/emacs-lisp/bytecomp.el'
--- a/lisp/emacs-lisp/bytecomp.el       2014-03-14 00:32:41 +0000
+++ b/lisp/emacs-lisp/bytecomp.el       2014-04-21 09:34:21 +0000
@@ -421,31 +421,46 @@
 
 (defvar byte-compiler-error-flag)
 
+(defun byte-compile-recurse-toplevel (form &optional non-toplevel-case)
+  "Implement `eval-when-compile' and `eval-and-compile'.
+Return the compile-time value of FORM."
+  ;; Macroexpand (not macroexpand-all!) form at toplevel in case it
+  ;; expands into a toplevel-equivalent `progn'.  See CLHS section
+  ;; 3.2.3.1, "Processing of Top Level Forms".  The semantics are very
+  ;; subtle: see test/automated/bytecomp-tests.el for interesting
+  ;; cases.
+  (setf form (macroexpand form byte-compile-macro-environment))
+  (if (eq (car-safe form) 'progn)
+      (cons 'progn
+            (mapcar (lambda (subform)
+                      (byte-compile-recurse-toplevel
+                       subform non-toplevel-case))
+                    (cdr form)))
+    (funcall non-toplevel-case form)))
+
 (defconst byte-compile-initial-macro-environment
   '(
     ;; (byte-compiler-options . (lambda (&rest forms)
     ;;                        (apply 'byte-compiler-options-handler forms)))
     (declare-function . byte-compile-macroexpand-declare-function)
     (eval-when-compile . (lambda (&rest body)
-                          (list
-                           'quote
-                           (byte-compile-eval
-                             (byte-compile-top-level
-                              (byte-compile-preprocess (cons 'progn body)))))))
+                           (let ((result nil))
+                             (byte-compile-recurse-toplevel
+                              (cons 'progn body)
+                              (lambda (form)
+                                (setf result
+                                      (byte-compile-eval
+                                       (byte-compile-top-level
+                                        (byte-compile-preprocess form))))))
+                             (list 'quote result))))
     (eval-and-compile . (lambda (&rest body)
-                          ;; Byte compile before running it.  Do it piece by
-                          ;; piece, in case further expressions need earlier
-                          ;; ones to be evaluated already, as is the case in
-                          ;; eieio.el.
-                          `(progn
-                             ,@(mapcar (lambda (exp)
-                                         (let ((cexp
-                                                (byte-compile-top-level
-                                                 (byte-compile-preprocess
-                                                  exp))))
-                                           (eval cexp)
-                                           cexp))
-                                       body)))))
+                          (byte-compile-recurse-toplevel
+                           (cons 'progn body)
+                           (lambda (form)
+                             (let ((compiled (byte-compile-top-level
+                                              (byte-compile-preprocess form))))
+                               (eval compiled)
+                               compiled))))))
   "The default macro-environment passed to macroexpand by the compiler.
 Placing a macro here will cause a macro to have different semantics when
 expanded by the compiler as when expanded by the interpreter.")
@@ -2198,9 +2213,12 @@
    (t form)))
 
 ;; byte-hunk-handlers cannot call this!
-(defun byte-compile-toplevel-file-form (form)
-  (let ((byte-compile-current-form nil))       ; close over this for warnings.
-    (byte-compile-file-form (byte-compile-preprocess form t))))
+(defun byte-compile-toplevel-file-form (top-level-form)
+  (byte-compile-recurse-toplevel
+   top-level-form
+   (lambda (form)
+     (let ((byte-compile-current-form nil)) ; close over this for warnings.
+       (byte-compile-file-form (byte-compile-preprocess form t))))))
 
 ;; byte-hunk-handlers can call this.
 (defun byte-compile-file-form (form)
@@ -2942,8 +2960,11 @@
                                            interactive-only))
                                   (t "."))))
         (if (eq (car-safe (symbol-function (car form))) 'macro)
-            (byte-compile-log-warning
-             (format "Forgot to expand macro %s" (car form)) nil :error))
+            (progn
+              (debug)
+              (byte-compile-log-warning
+               (format "Forgot to expand macro %s in %S" (car form) form)
+               nil :error)))
         (if (and handler
                  ;; Make sure that function exists.
                  (and (functionp handler)

=== modified file 'lisp/emacs-lisp/macroexp.el'
--- a/lisp/emacs-lisp/macroexp.el       2014-01-01 07:43:34 +0000
+++ b/lisp/emacs-lisp/macroexp.el       2014-04-21 09:34:21 +0000
@@ -97,7 +97,10 @@
 (defun macroexp--compiler-macro (handler form)
   (condition-case err
       (apply handler form (cdr form))
-    (error (message "Compiler-macro error for %S: %S" (car form) err)
+    (error
+     (message "--------------------------------------------------")
+     (backtrace)
+     (message "Compiler-macro error for %S: %S" (car form) err)
            form)))
 
 (defun macroexp--funcall-if-compiled (_form)

=== modified file 'test/ChangeLog'
--- a/test/ChangeLog    2014-04-21 01:28:55 +0000
+++ b/test/ChangeLog    2014-04-21 09:34:21 +0000
@@ -1,5 +1,12 @@
 2014-04-21  Daniel Colascione  <address@hidden>
 
+       * automated/bytecomp-tests.el (test-byte-comp-compile-and-load):
+       New function.
+       (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): New tests.
+
        * automated/cl-lib.el (cl-loop-destructuring-with): New test.
        (cl-the): Fix cl-the test.
 

=== modified file 'test/automated/bytecomp-tests.el'
--- a/test/automated/bytecomp-tests.el  2014-01-01 07:43:34 +0000
+++ b/test/automated/bytecomp-tests.el  2014-04-21 09:34:21 +0000
@@ -305,6 +305,56 @@
                            'face fail-face)))
       (insert "\n"))))
 
+(defun test-byte-comp-compile-and-load (&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"))
+           (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)))
+      (when elfile (delete-file elfile))
+      (when elcfile (delete-file elcfile)))))
+(put 'test-byte-comp-compile-and-load 'lisp-indent-function 0)
+
+(ert-deftest test-byte-comp-macro-expansion ()
+  (test-byte-comp-compile-and-load
+    '(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
+    '(eval-and-compile (defmacro abc (arg) -1) (defun def () (abc 2))))
+  (should (equal (funcall 'def) -1)))
+
+(ert-deftest test-byte-comp-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
+    '(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-byte-comp-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
+    '(require 'cl-lib)
+    '(cl-macrolet ((m () 4))
+      (defmacro m () 5)
+      (defun def () (m))))
+  (should (equal (funcall 'def) 4)))
 
 ;; Local Variables:
 ;; no-byte-compile: t