procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Correctly treat progn contents as toplevel forms when byte compiling

Browse source
This commit is contained in:
Daniel Colascione 2014-04-21 02:34:21 -07:00
parent 0c8d94555c
commit 985c035f2d
5 changed files with 111 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lisp/ChangeLog
View file

@ -1,5 +1,11 @@
2014-04-21 Daniel Colascione <dancol@dancol.org>
* 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.

67
lisp/emacs-lisp/bytecomp.el
View file

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

5
lisp/emacs-lisp/macroexp.el
View file

@ -97,7 +97,10 @@ each clause."
(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)

7
test/ChangeLog
View file

@ -1,5 +1,12 @@
2014-04-21 Daniel Colascione <dancol@dancol.org>
* 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.

50
test/automated/bytecomp-tests.el
View file

@ -305,6 +305,56 @@ Subtests signal errors if something goes wrong."
'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