BYTE_COMPILE_FLAGS = \
--eval '(setq load-prefer-newer t)' $(BYTE_COMPILE_EXTRA_FLAGS)
# ... but we must prefer .elc files for those in the early bootstrap.
-compile-first: BYTE_COMPILE_FLAGS = $(BYTE_COMPILE_EXTRA_FLAGS)
+# A larger `max-specpdl-size' is needed for emacs-lisp/comp.el.
+compile-first: BYTE_COMPILE_FLAGS = \
+ --eval '(setq max-specpdl-size 5000)' $(BYTE_COMPILE_EXTRA_FLAGS)
# Files to compile before others during a bootstrap. This is done to
# speed up the bootstrap process. They're ordered by size, so we use
(let ((exps-opt (byte-optimize-body exps t)))
(if (macroexp-const-p exp-opt)
`(progn ,@exps-opt ,exp-opt)
- `(prog1 ,exp-opt ,@exps-opt)))
+ `(,fn ,exp-opt ,@exps-opt)))
exp-opt)))
(`(,(or `save-excursion `save-restriction `save-current-buffer) . ,exps)
(then-opt (and test-opt (byte-optimize-form then for-effect)))
(else-opt (and (not (and test-opt const))
(byte-optimize-body else for-effect))))
- `(if ,test-opt ,then-opt . ,else-opt)))
+ `(,fn ,test-opt ,then-opt . ,else-opt)))
(`(,(or 'and 'or) . ,exps)
;; FIXME: We have to traverse the expressions in left-to-right
;; as mutated variables have been marked as non-substitutable.
(condition (byte-optimize-form (car condition-body) nil))
(body (byte-optimize-body (cdr condition-body) t)))
- `(while ,condition . ,body)))
+ `(,fn ,condition . ,body)))
(`(interactive . ,_)
(byte-compile-warn-x form "misplaced interactive spec: `%s'" form)
form)
(`(condition-case ,var ,exp . ,clauses)
- `(condition-case ,var ;Not evaluated.
+ `(,fn ,var ;Not evaluated.
,(byte-optimize-form exp for-effect)
,@(mapcar (lambda (clause)
(let ((byte-optimize--lexvars
(let ((bodyform (byte-optimize-form exp for-effect)))
(pcase exps
(`(:fun-body ,f)
- `(unwind-protect ,bodyform
+ `(,fn ,bodyform
:fun-body ,(byte-optimize-form f nil)))
(_
- `(unwind-protect ,bodyform
+ `(,fn ,bodyform
. ,(byte-optimize-body exps t))))))
(`(catch ,tag . ,exps)
- `(catch ,(byte-optimize-form tag nil)
+ `(,fn ,(byte-optimize-form tag nil)
. ,(byte-optimize-body exps for-effect)))
;; Needed as long as we run byte-optimize-form after cconv.
(cons (byte-optimize-form (car rest) nil)
(cdr rest)))))
(push name byte-optimize--dynamic-vars)
- `(defvar ,name . ,optimized-rest)))
+ `(,fn ,name . ,optimized-rest)))
(`(,(pred byte-code-function-p) . ,exps)
(cons fn (mapcar #'byte-optimize-form exps)))
(defun byte-optimize--rename-var (var new-var form)
"Replace VAR with NEW-VAR in FORM."
- (pcase form
- ((pred symbolp) (if (eq form var) new-var form))
- (`(setq . ,args)
- (let ((new-args nil))
- (while args
- (push (byte-optimize--rename-var var new-var (car args)) new-args)
- (push (byte-optimize--rename-var var new-var (cadr args)) new-args)
- (setq args (cddr args)))
- `(setq . ,(nreverse new-args))))
- ;; In binding constructs like `let', `let*' and `condition-case' we
- ;; rename everything for simplicity, even new bindings named VAR.
- (`(,(and head (or 'let 'let*)) ,bindings . ,body)
- `(,head
- ,(mapcar (lambda (b) (byte-optimize--rename-var-body var new-var b))
- bindings)
- ,@(byte-optimize--rename-var-body var new-var body)))
- (`(condition-case ,res-var ,protected-form . ,handlers)
- `(condition-case ,(byte-optimize--rename-var var new-var res-var)
- ,(byte-optimize--rename-var var new-var protected-form)
- ,@(mapcar (lambda (h)
- (cons (car h)
- (byte-optimize--rename-var-body var new-var (cdr h))))
- handlers)))
- (`(internal-make-closure ,vars ,env . ,rest)
- `(internal-make-closure
- ,vars ,(byte-optimize--rename-var-body var new-var env) . ,rest))
- (`(defvar ,name . ,rest)
- ;; NAME is not renamed here; we only care about lexical variables.
- `(defvar ,name . ,(byte-optimize--rename-var-body var new-var rest)))
-
- (`(cond . ,clauses)
- `(cond ,@(mapcar (lambda (c)
- (byte-optimize--rename-var-body var new-var c))
- clauses)))
-
- (`(function . ,_) form)
- (`(quote . ,_) form)
- (`(lambda . ,_) form)
-
- ;; Function calls and special forms not handled above.
- (`(,head . ,args)
- `(,head . ,(byte-optimize--rename-var-body var new-var args)))
- (_ form)))
+ (let ((fn (car-safe form)))
+ (pcase form
+ ((pred symbolp) (if (eq form var) new-var form))
+ (`(setq . ,args)
+ (let ((new-args nil))
+ (while args
+ (push (byte-optimize--rename-var var new-var (car args)) new-args)
+ (push (byte-optimize--rename-var var new-var (cadr args)) new-args)
+ (setq args (cddr args)))
+ `(,fn . ,(nreverse new-args))))
+ ;; In binding constructs like `let', `let*' and `condition-case' we
+ ;; rename everything for simplicity, even new bindings named VAR.
+ (`(,(and head (or 'let 'let*)) ,bindings . ,body)
+ `(,head
+ ,(mapcar (lambda (b) (byte-optimize--rename-var-body var new-var b))
+ bindings)
+ ,@(byte-optimize--rename-var-body var new-var body)))
+ (`(condition-case ,res-var ,protected-form . ,handlers)
+ `(,fn ,(byte-optimize--rename-var var new-var res-var)
+ ,(byte-optimize--rename-var var new-var protected-form)
+ ,@(mapcar (lambda (h)
+ (cons (car h)
+ (byte-optimize--rename-var-body var new-var (cdr h))))
+ handlers)))
+ (`(internal-make-closure ,vars ,env . ,rest)
+ `(,fn
+ ,vars ,(byte-optimize--rename-var-body var new-var env) . ,rest))
+ (`(defvar ,name . ,rest)
+ ;; NAME is not renamed here; we only care about lexical variables.
+ `(,fn ,name . ,(byte-optimize--rename-var-body var new-var rest)))
+
+ (`(cond . ,clauses)
+ `(,fn ,@(mapcar (lambda (c)
+ (byte-optimize--rename-var-body var new-var c))
+ clauses)))
+
+ (`(function . ,_) form)
+ (`(quote . ,_) form)
+ (`(lambda . ,_) form)
+
+ ;; Function calls and special forms not handled above.
+ (`(,head . ,args)
+ `(,head . ,(byte-optimize--rename-var-body var new-var args)))
+ (_ form))))
(defun byte-optimize-let-form (head form for-effect)
;; Recursively enter the optimizer for the bindings and body
(proper-list-p clause))
(if (null (cddr clause))
;; A trivial `progn'.
- (byte-optimize-if `(if ,(cadr clause) ,@(nthcdr 2 form)))
+ (byte-optimize-if `(,(car form) ,(cadr clause) ,@(nthcdr 2 form)))
(nconc (butlast clause)
(list
(byte-optimize-if
- `(if ,(car (last clause)) ,@(nthcdr 2 form)))))))
+ `(,(car form) ,(car (last clause)) ,@(nthcdr 2 form)))))))
((byte-compile-trueconstp clause)
`(progn ,clause ,(nth 2 form)))
((byte-compile-nilconstp clause)
`(progn ,clause ,@(nthcdr 3 form)))
((nth 2 form)
(if (equal '(nil) (nthcdr 3 form))
- (list 'if clause (nth 2 form))
+ (list (car form) clause (nth 2 form))
form))
((or (nth 3 form) (nthcdr 4 form))
- (list 'if
+ (list (car form)
;; Don't make a double negative;
;; instead, take away the one that is there.
(if (and (consp clause) (memq (car clause) '(not null))
(and (consp binding) (cadr binding)))
bindings)
,const)
- `(let* ,(butlast bindings)
+ `(,head ,(butlast bindings)
,@(and (consp (car (last bindings)))
(cdar (last bindings)))
,const)))
`(progn ,@(mapcar (lambda (binding)
(and (consp binding) (cadr binding)))
bindings))
- `(let* ,(butlast bindings)
+ `(,head ,(butlast bindings)
,@(and (consp (car (last bindings)))
(cdar (last bindings))))))
(let ((print-symbols-bare t)) ; Possibly redundant binding.
(setf form (macroexp-macroexpand form byte-compile-macro-environment)))
(if (eq (car-safe form) 'progn)
- (cons 'progn
+ (cons (car form)
(mapcar (lambda (subform)
(byte-compile-recurse-toplevel
subform non-toplevel-case))
;; which may include "calls" to
;; internal-make-closure (Bug#29988).
lexical-binding)
- (setq int `(interactive ,newform)))))
+ (setq int `(,(car int) ,newform)))))
((cdr int) ; Invalid (interactive . something).
(byte-compile-warn-x int "malformed interactive spec: %s"
int))))
args)))
(`(cond . ,cond-forms) ; cond special form
- `(cond . ,(mapcar (lambda (branch)
- (mapcar (lambda (form)
- (cconv-convert form env extend))
- branch))
- cond-forms)))
+ `(,(car form) . ,(mapcar (lambda (branch)
+ (mapcar (lambda (form)
+ (cconv-convert form env extend))
+ branch))
+ cond-forms)))
(`(function (lambda ,args . ,body) . ,_)
(let ((docstring (if (eq :documentation (car-safe (car body)))
(msg (when (eq class :unused)
(cconv--warn-unused-msg var "variable")))
(newprotform (cconv-convert protected-form env extend)))
- `(condition-case ,var
+ `(,(car form) ,var
,(if msg
(macroexp--warn-wrap var msg newprotform 'lexical)
newprotform)
`((let ((,var (list ,var))) ,@body))))))
handlers))))
- (`(unwind-protect ,form . ,body)
- `(unwind-protect ,(cconv-convert form env extend)
- :fun-body ,(cconv--convert-function () body env form)))
+ (`(unwind-protect ,form1 . ,body)
+ `(,(car form) ,(cconv-convert form1 env extend)
+ :fun-body ,(cconv--convert-function () body env form1)))
(`(setq . ,forms) ; setq special form
(if (= (logand (length forms) 1) 1)
(sym-new (or (cdr (assq sym env)) sym))
(value (cconv-convert (pop forms) env extend)))
(push (pcase sym-new
- ((pred symbolp) `(setq ,sym-new ,value))
+ ((pred symbolp) `(,(car form) ,sym-new ,value))
(`(car-safe ,iexp) `(setcar ,iexp ,value))
;; This "should never happen", but for variables which are
;; mutated+captured+unused, we may end up trying to `setq'
(cons fun args)))))))
(`(interactive . ,forms)
- `(interactive . ,(mapcar (lambda (form)
+ `(,(car form) . ,(mapcar (lambda (form)
(cconv-convert form nil nil))
forms)))
(setq form (macroexp-macroexpand form macroexpand-all-environment))
;; FIXME: It'd be nice to use `byte-optimize--pcase' here, but when
;; I tried it, it broke the bootstrap :-(
- (pcase form
- (`(cond . ,clauses)
- (macroexp--cons 'cond (macroexp--all-clauses clauses) form))
- (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare))
- (macroexp--cons
- 'condition-case
- (macroexp--cons err
- (macroexp--cons (macroexp--expand-all body)
- (macroexp--all-clauses handlers 1)
- (cddr form))
- (cdr form))
- form))
- (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_)
- (push name macroexp--dynvars)
- (macroexp--all-forms form 2))
- (`(function ,(and f `(lambda . ,_)))
- (let ((macroexp--dynvars macroexp--dynvars))
- (macroexp--cons 'function
- (macroexp--cons (macroexp--all-forms f 2)
- nil
- (cdr form))
- form)))
- (`(,(or 'function 'quote) . ,_) form)
- (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body)
- pcase--dontcare))
- (let ((macroexp--dynvars macroexp--dynvars))
+ (let ((fn (car-safe form)))
+ (pcase form
+ (`(cond . ,clauses)
+ (macroexp--cons fn (macroexp--all-clauses clauses) form))
+ (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare))
(macroexp--cons
- fun
- (macroexp--cons
- (macroexp--all-clauses bindings 1)
- (if (null body)
- (macroexp-unprogn
- (macroexp-warn-and-return
- (format "Empty %s body" fun)
- nil nil 'compile-only fun))
- (macroexp--all-forms body))
- (cdr form))
- form)))
- (`(,(and fun `(lambda . ,_)) . ,args)
- ;; Embedded lambda in function position.
- ;; If the byte-optimizer is loaded, try to unfold this,
- ;; i.e. rewrite it to (let (<args>) <body>). We'd do it in the optimizer
- ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the
- ;; creation of a closure, thus resulting in much better code.
- (let ((newform (macroexp--unfold-lambda form)))
- (if (eq newform form)
- ;; Unfolding failed for some reason, avoid infinite recursion.
- (macroexp--cons (macroexp--all-forms fun 2)
- (macroexp--all-forms args)
- form)
- (macroexp--expand-all newform))))
- (`(funcall ,exp . ,args)
- (let ((eexp (macroexp--expand-all exp))
- (eargs (macroexp--all-forms args)))
- ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
- ;; has a compiler-macro, or to unfold it.
- (pcase eexp
- ((and `#',f
- (guard (not (or (special-form-p f) (macrop f))))) ;; bug#46636
- (macroexp--expand-all `(,f . ,eargs)))
- (_ `(funcall ,eexp . ,eargs)))))
- (`(funcall . ,_) form) ;bug#53227
- (`(,func . ,_)
- (let ((handler (function-get func 'compiler-macro))
- (funargs (function-get func 'funarg-positions)))
- ;; Check functions quoted with ' rather than with #'
- (dolist (funarg funargs)
- (let ((arg (nth funarg form)))
- (when (and (eq 'quote (car-safe arg))
- (eq 'lambda (car-safe (cadr arg))))
- (setcar (nthcdr funarg form)
- (macroexp-warn-and-return
- (format "%S quoted with ' rather than with #'"
- (let ((f (cadr arg)))
- (if (symbolp f) f `(lambda ,(nth 1 f) ...))))
- arg nil nil (cadr arg))))))
- ;; Macro expand compiler macros. This cannot be delayed to
- ;; byte-optimize-form because the output of the compiler-macro can
- ;; use macros.
- (if (null handler)
- ;; No compiler macro. We just expand each argument (for
- ;; setq/setq-default this works alright because the variable names
- ;; are symbols).
- (macroexp--all-forms form 1)
- ;; If the handler is not loaded yet, try (auto)loading the
- ;; function itself, which may in turn load the handler.
- (unless (functionp handler)
- (with-demoted-errors "macroexp--expand-all: %S"
- (autoload-do-load (indirect-function func) func)))
- (let ((newform (macroexp--compiler-macro handler form)))
- (if (eq form newform)
- ;; The compiler macro did not find anything to do.
- (if (equal form (setq newform (macroexp--all-forms form 1)))
- form
- ;; Maybe after processing the args, some new opportunities
- ;; appeared, so let's try the compiler macro again.
- (setq form (macroexp--compiler-macro handler newform))
- (if (eq newform form)
- newform
- (macroexp--expand-all newform)))
- (macroexp--expand-all newform))))))
- (_ form)))
+ fn
+ (macroexp--cons err
+ (macroexp--cons (macroexp--expand-all body)
+ (macroexp--all-clauses handlers 1)
+ (cddr form))
+ (cdr form))
+ form))
+ (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_)
+ (push name macroexp--dynvars)
+ (macroexp--all-forms form 2))
+ (`(function ,(and f `(lambda . ,_)))
+ (let ((macroexp--dynvars macroexp--dynvars))
+ (macroexp--cons fn
+ (macroexp--cons (macroexp--all-forms f 2)
+ nil
+ (cdr form))
+ form)))
+ (`(,(or 'function 'quote) . ,_) form)
+ (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body)
+ pcase--dontcare))
+ (let ((macroexp--dynvars macroexp--dynvars))
+ (macroexp--cons
+ fun
+ (macroexp--cons
+ (macroexp--all-clauses bindings 1)
+ (if (null body)
+ (macroexp-unprogn
+ (macroexp-warn-and-return
+ (format "Empty %s body" fun)
+ nil nil 'compile-only fun))
+ (macroexp--all-forms body))
+ (cdr form))
+ form)))
+ (`(,(and fun `(lambda . ,_)) . ,args)
+ ;; Embedded lambda in function position.
+ ;; If the byte-optimizer is loaded, try to unfold this,
+ ;; i.e. rewrite it to (let (<args>) <body>). We'd do it in the optimizer
+ ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the
+ ;; creation of a closure, thus resulting in much better code.
+ (let ((newform (macroexp--unfold-lambda form)))
+ (if (eq newform form)
+ ;; Unfolding failed for some reason, avoid infinite recursion.
+ (macroexp--cons (macroexp--all-forms fun 2)
+ (macroexp--all-forms args)
+ form)
+ (macroexp--expand-all newform))))
+ (`(funcall ,exp . ,args)
+ (let ((eexp (macroexp--expand-all exp))
+ (eargs (macroexp--all-forms args)))
+ ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
+ ;; has a compiler-macro, or to unfold it.
+ (pcase eexp
+ ((and `#',f
+ (guard (not (or (special-form-p f) (macrop f))))) ;; bug#46636
+ (macroexp--expand-all `(,f . ,eargs)))
+ (_ `(funcall ,eexp . ,eargs)))))
+ (`(funcall . ,_) form) ;bug#53227
+ (`(,func . ,_)
+ (let ((handler (function-get func 'compiler-macro))
+ (funargs (function-get func 'funarg-positions)))
+ ;; Check functions quoted with ' rather than with #'
+ (dolist (funarg funargs)
+ (let ((arg (nth funarg form)))
+ (when (and (eq 'quote (car-safe arg))
+ (eq 'lambda (car-safe (cadr arg))))
+ (setcar (nthcdr funarg form)
+ (macroexp-warn-and-return
+ (format "%S quoted with ' rather than with #'"
+ (let ((f (cadr arg)))
+ (if (symbolp f) f `(lambda ,(nth 1 f) ...))))
+ arg nil nil (cadr arg))))))
+ ;; Macro expand compiler macros. This cannot be delayed to
+ ;; byte-optimize-form because the output of the compiler-macro can
+ ;; use macros.
+ (if (null handler)
+ ;; No compiler macro. We just expand each argument (for
+ ;; setq/setq-default this works alright because the variable names
+ ;; are symbols).
+ (macroexp--all-forms form 1)
+ ;; If the handler is not loaded yet, try (auto)loading the
+ ;; function itself, which may in turn load the handler.
+ (unless (functionp handler)
+ (with-demoted-errors "macroexp--expand-all: %S"
+ (autoload-do-load (indirect-function func) func)))
+ (let ((newform (macroexp--compiler-macro handler form)))
+ (if (eq form newform)
+ ;; The compiler macro did not find anything to do.
+ (if (equal form (setq newform (macroexp--all-forms form 1)))
+ form
+ ;; Maybe after processing the args, some new opportunities
+ ;; appeared, so let's try the compiler macro again.
+ (setq form (macroexp--compiler-macro handler newform))
+ (if (eq newform form)
+ newform
+ (macroexp--expand-all newform)))
+ (macroexp--expand-all newform))))))
+ (_ form))))
(pop byte-compile-form-stack)))
;; Record which arguments expect functions, so we can warn when those
projects / emacs.git / commitdiff