summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/bytecomp.el
diff options
context:
space:
mode:
authorDaniel Colascione <dancol@dancol.org>2014-04-21 02:34:21 -0700
committerDaniel Colascione <dancol@dancol.org>2014-04-21 02:34:21 -0700
commit985c035f2d4cf326a816fe463c400be96e358be2 (patch)
tree8db28fe4100f4e5988824dcc956fd6a7088e98ae /lisp/emacs-lisp/bytecomp.el
parent0c8d94555ce550d87afd6293bf5d17e864c13864 (diff)
downloademacs-985c035f2d4cf326a816fe463c400be96e358be2.tar.gz
Correctly treat progn contents as toplevel forms when byte compiling
Diffstat (limited to 'lisp/emacs-lisp/bytecomp.el')
-rw-r--r--lisp/emacs-lisp/bytecomp.el67
1 files changed, 44 insertions, 23 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index e5f8a8cc22a..923d2067a49 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -421,31 +421,46 @@ Filled in `cconv-analyse-form' but initialized and consulted here.")
(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 @@ list that represents a doc string reference.
(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 @@ for symbols generated by the byte compiler itself."
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)