Commit 57db3f3a authored by Stefan Monnier's avatar Stefan Monnier

Fix bootstrap failure after last change to eval-and-compile.

* lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment):
Don't call byte-compile-preprocess since the result will go through cconv.
(byte-compile-output-docform): Handle uninterned `name' correctly.
* lisp/emacs-lisp/cl-macs.el (cl-define-compiler-macro): Use interned name
to circumvent byte-compiler bug.

* lisp/emacs-lisp/cl-extra.el (cl-get): Silence compiler warning.

* lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Fix typo.
(macroexp--compiler-macro): Remove left-over debug code.
parent f8626941
2014-11-09 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment):
Don't call byte-compile-preprocess since the result will go through
cconv.
(byte-compile-output-docform): Handle uninterned `name' correctly.
* emacs-lisp/cl-macs.el (cl-define-compiler-macro): Use interned name
to circumvent byte-compiler bug.
* emacs-lisp/macroexp.el (macroexp--expand-all): Fix typo.
(macroexp--compiler-macro): Remove left-over debug code.
* emacs-lisp/cl-extra.el (cl-get): Silence compiler warning.
2014-11-08 Juri Linkov <juri@jurta.org>
* simple.el (shell-command): Use buffer-name when output-buffer is
......
......@@ -115,8 +115,7 @@ If `error-free', drop calls even if `byte-compile-delete-errors' is nil.")
(if (not (eq (car-safe compiler-function) 'lambda))
`(eval-and-compile
(function-put ',f 'compiler-macro #',compiler-function))
(let ((cfname (intern (concat (symbol-name f)
"--anon-compiler-macro"))))
(let ((cfname (intern (concat (symbol-name f) "--anon-cmacro"))))
`(progn
(eval-and-compile
(function-put ',f 'compiler-macro #',cfname))
......
......@@ -448,26 +448,28 @@ Return the compile-time value of FORM."
;; (apply 'byte-compiler-options-handler forms)))
(declare-function . byte-compile-macroexpand-declare-function)
(eval-when-compile . ,(lambda (&rest 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))))
(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-recurse-toplevel
(cons 'progn body)
(lambda (form)
;; Don't compile here, since we don't know
;; whether to compile as byte-compile-form
;; or byte-compile-file-form.
(let ((expanded
(byte-compile-preprocess form)))
(eval expanded lexical-binding)
expanded))))))
(byte-compile-recurse-toplevel
(cons 'progn body)
(lambda (form)
;; Don't compile here, since we don't know
;; whether to compile as byte-compile-form
;; or byte-compile-file-form.
(let ((expanded
(macroexpand-all
form
macroexpand-all-environment)))
(eval expanded lexical-binding)
expanded))))))
"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.")
......@@ -2122,11 +2124,6 @@ list that represents a doc string reference.
(eq (aref (nth (nth 1 info) form) 0) ?*))
(setq position (- position)))))
(if preface
(progn
(insert preface)
(prin1 name byte-compile--outbuffer)))
(insert (car info))
(let ((print-continuous-numbering t)
print-number-table
(index 0)
......@@ -2139,6 +2136,15 @@ list that represents a doc string reference.
(print-gensym t)
(print-circle ; Handle circular data structures.
(not byte-compile-disable-print-circle)))
(if preface
(progn
;; FIXME: We don't handle uninterned names correctly.
;; E.g. if cl-define-compiler-macro uses uninterned name we get:
;; (defalias '#1=#:foo--cmacro #[514 ...])
;; (put 'foo 'compiler-macro '#:foo--cmacro)
(insert preface)
(prin1 name byte-compile--outbuffer)))
(insert (car info))
(prin1 (car form) byte-compile--outbuffer)
(while (setq form (cdr form))
(setq index (1+ index))
......
......@@ -588,7 +588,7 @@ If START or END is negative, it counts from the end."
"Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
\n(fn SYMBOL PROPNAME &optional DEFAULT)"
(declare (compiler-macro cl--compiler-macro-get)
(gv-setter (lambda (store) `(put ,sym ,tag ,store))))
(gv-setter (lambda (store) (ignore def) `(put ,sym ,tag ,store))))
(or (get sym tag)
(and def
;; Make sure `def' is really absent as opposed to set to nil.
......
......@@ -2767,7 +2767,12 @@ and then returning foo."
(let ((p args) (res nil))
(while (consp p) (push (pop p) res))
(setq args (nconc (nreverse res) (and p (list '&rest p)))))
(let ((fname (make-symbol (concat (symbol-name func) "--cmacro"))))
;; FIXME: The code in bytecomp mishandles top-level expressions that define
;; uninterned functions. E.g. it would generate code like:
;; (defalias '#1=#:foo--cmacro #[514 ...])
;; (put 'foo 'compiler-macro '#:foo--cmacro)
;; So we circumvent this by using an interned name.
(let ((fname (intern (concat (symbol-name func) "--cmacro"))))
`(eval-and-compile
;; Name the compiler-macro function, so that `symbol-file' can find it.
(cl-defun ,fname ,(if (memq '&whole args) (delq '&whole args)
......
......@@ -97,8 +97,6 @@ each clause."
(condition-case err
(apply handler form (cdr form))
(error
(message "--------------------------------------------------")
(backtrace)
(message "Compiler-macro error for %S: %S" (car form) err)
form)))
......@@ -251,7 +249,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
(format "%s quoted with ' rather than with #'"
(list 'lambda (nth 1 f) '...))
(macroexp--expand-all `(,fun ,arg1 ,f . ,args))))
(`(funcall (,(or 'quote 'function) ,(and f (pred symbolp) . ,_)) . ,args)
(`(funcall (,(or 'quote 'function) ,(and f (pred symbolp)) . ,_) . ,args)
;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
;; has a compiler-macro.
(macroexp--expand-all `(,f . ,args)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment