Line data Source code
1 : ;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t -*-
2 : ;;
3 : ;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
4 : ;;
5 : ;; Author: Miles Bader <miles@gnu.org>
6 : ;; Keywords: lisp, compiler, macros
7 :
8 : ;; This file is part of GNU Emacs.
9 :
10 : ;; GNU Emacs is free software: you can redistribute it and/or modify
11 : ;; it under the terms of the GNU General Public License as published by
12 : ;; the Free Software Foundation, either version 3 of the License, or
13 : ;; (at your option) any later version.
14 :
15 : ;; GNU Emacs is distributed in the hope that it will be useful,
16 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 : ;; GNU General Public License for more details.
19 :
20 : ;; You should have received a copy of the GNU General Public License
21 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22 :
23 : ;;; Commentary:
24 : ;;
25 : ;; This file contains macro-expansions functions that are not defined in
26 : ;; the Lisp core, namely `macroexpand-all', which expands all macros in
27 : ;; a form, not just a top-level one.
28 :
29 : ;;; Code:
30 :
31 : ;; Bound by the top-level `macroexpand-all', and modified to include any
32 : ;; macros defined by `defmacro'.
33 : (defvar macroexpand-all-environment nil)
34 :
35 : (defun macroexp--cons (car cdr original-cons)
36 : "Return (CAR . CDR), using ORIGINAL-CONS if possible."
37 152454 : (if (and (eq car (car original-cons)) (eq cdr (cdr original-cons)))
38 117562 : original-cons
39 152454 : (cons car cdr)))
40 :
41 : ;; We use this special macro to iteratively process forms and share list
42 : ;; structure of the result with the input. Doing so recursively using
43 : ;; `macroexp--cons' results in excessively deep recursion for very long
44 : ;; input forms.
45 : (defmacro macroexp--accumulate (var+list &rest body)
46 : "Return a list of the results of evaluating BODY for each element of LIST.
47 : Evaluate BODY with VAR bound to each `car' from LIST, in turn.
48 : Return a list of the values of the final form in BODY.
49 : The list structure of the result will share as much with LIST as
50 : possible (for instance, when BODY just returns VAR unchanged, the
51 : result will be eq to LIST).
52 :
53 : \(fn (VAR LIST) BODY...)"
54 : (declare (indent 1))
55 2 : (let ((var (car var+list))
56 2 : (list (cadr var+list))
57 2 : (shared (make-symbol "shared"))
58 2 : (unshared (make-symbol "unshared"))
59 2 : (tail (make-symbol "tail"))
60 2 : (new-el (make-symbol "new-el")))
61 2 : `(let* ((,shared ,list)
62 2 : (,unshared nil)
63 2 : (,tail ,shared)
64 2 : ,var ,new-el)
65 2 : (while (consp ,tail)
66 2 : (setq ,var (car ,tail)
67 2 : ,new-el (progn ,@body))
68 2 : (unless (eq ,var ,new-el)
69 2 : (while (not (eq ,shared ,tail))
70 2 : (push (pop ,shared) ,unshared))
71 2 : (setq ,shared (cdr ,shared))
72 2 : (push ,new-el ,unshared))
73 2 : (setq ,tail (cdr ,tail)))
74 2 : (nconc (nreverse ,unshared) ,shared))))
75 :
76 : (defun macroexp--all-forms (forms &optional skip)
77 : "Return FORMS with macros expanded. FORMS is a list of forms.
78 : If SKIP is non-nil, then don't expand that many elements at the start of
79 : FORMS."
80 772908 : (macroexp--accumulate (form forms)
81 : (if (or (null skip) (zerop skip))
82 : (macroexp--expand-all form)
83 : (setq skip (1- skip))
84 772908 : form)))
85 :
86 : (defun macroexp--all-clauses (clauses &optional skip)
87 : "Return CLAUSES with macros expanded.
88 : CLAUSES is a list of lists of forms; any clause that's not a list is ignored.
89 : If SKIP is non-nil, then don't expand that many elements at the start of
90 : each clause."
91 61280 : (macroexp--accumulate (clause clauses)
92 : (if (listp clause)
93 : (macroexp--all-forms clause skip)
94 61280 : clause)))
95 :
96 : (defun macroexp--compiler-macro (handler form)
97 9342 : (condition-case err
98 9342 : (apply handler form (cdr form))
99 : (error
100 0 : (message "Compiler-macro error for %S: %S" (car form) err)
101 9342 : form)))
102 :
103 : (defun macroexp--funcall-if-compiled (_form)
104 : "Pseudo function used internally by macroexp to delay warnings.
105 : The purpose is to delay warnings to bytecomp.el, so they can use things
106 : like `byte-compile-warn' to get better file-and-line-number data
107 : and also to avoid outputting the warning during normal execution."
108 : nil)
109 : (put 'macroexp--funcall-if-compiled 'byte-compile
110 : (lambda (form)
111 : (funcall (eval (cadr form)))
112 : (byte-compile-constant nil)))
113 :
114 : (defun macroexp--compiling-p ()
115 : "Return non-nil if we're macroexpanding for the compiler."
116 : ;; FIXME: ¡¡Major Ugly Hack!! To determine whether the output of this
117 : ;; macro-expansion will be processed by the byte-compiler, we check
118 : ;; circumstantial evidence.
119 6 : (member '(declare-function . byte-compile-macroexpand-declare-function)
120 6 : macroexpand-all-environment))
121 :
122 : (defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key))
123 :
124 : (defun macroexp--warn-and-return (msg form &optional compile-only)
125 0 : (let ((when-compiled (lambda () (byte-compile-warn "%s" msg))))
126 0 : (cond
127 0 : ((null msg) form)
128 0 : ((macroexp--compiling-p)
129 0 : (if (gethash form macroexp--warned)
130 : ;; Already wrapped this exp with a warning: avoid inf-looping
131 : ;; where we keep adding the same warning onto `form' because
132 : ;; macroexpand-all gets right back to macroexpanding `form'.
133 0 : form
134 0 : (puthash form form macroexp--warned)
135 0 : `(progn
136 0 : (macroexp--funcall-if-compiled ',when-compiled)
137 0 : ,form)))
138 : (t
139 0 : (unless compile-only
140 0 : (message "%s%s" (if (stringp load-file-name)
141 0 : (concat (file-relative-name load-file-name) ": ")
142 0 : "")
143 0 : msg))
144 0 : form))))
145 :
146 : (defun macroexp--obsolete-warning (fun obsolescence-data type)
147 0 : (let ((instead (car obsolescence-data))
148 0 : (asof (nth 2 obsolescence-data)))
149 0 : (format-message
150 0 : "`%s' is an obsolete %s%s%s" fun type
151 0 : (if asof (concat " (as of " asof ")") "")
152 0 : (cond ((stringp instead) (concat "; " (substitute-command-keys instead)))
153 0 : (instead (format-message "; use `%s' instead." instead))
154 0 : (t ".")))))
155 :
156 : (defun macroexpand-1 (form &optional environment)
157 : "Perform (at most) one step of macroexpansion."
158 366 : (cond
159 366 : ((consp form)
160 366 : (let* ((head (car form))
161 366 : (env-expander (assq head environment)))
162 366 : (if env-expander
163 0 : (if (cdr env-expander)
164 0 : (apply (cdr env-expander) (cdr form))
165 0 : form)
166 366 : (if (not (and (symbolp head) (fboundp head)))
167 0 : form
168 366 : (let ((def (autoload-do-load (symbol-function head) head 'macro)))
169 366 : (cond
170 : ;; Follow alias, but only for macros, otherwise we may end up
171 : ;; skipping an important compiler-macro (e.g. cl--block-wrapper).
172 366 : ((and (symbolp def) (macrop def)) (cons def (cdr form)))
173 366 : ((not (consp def)) form)
174 : (t
175 242 : (if (eq 'macro (car def))
176 124 : (apply (cdr def) (cdr form))
177 366 : form))))))))
178 366 : (t form)))
179 :
180 : (defun macroexp-macroexpand (form env)
181 : "Like `macroexpand' but checking obsolescence."
182 1513090 : (let ((new-form
183 1513090 : (macroexpand form env)))
184 1513090 : (if (and (not (eq form new-form)) ;It was a macro call.
185 26501 : (car-safe form)
186 26501 : (symbolp (car form))
187 26501 : (get (car form) 'byte-obsolete-info)
188 0 : (or (not (fboundp 'byte-compile-warning-enabled-p))
189 1513090 : (byte-compile-warning-enabled-p 'obsolete)))
190 0 : (let* ((fun (car form))
191 0 : (obsolete (get fun 'byte-obsolete-info)))
192 0 : (macroexp--warn-and-return
193 0 : (macroexp--obsolete-warning
194 0 : fun obsolete
195 0 : (if (symbolp (symbol-function fun))
196 0 : "alias" "macro"))
197 0 : new-form))
198 1513090 : new-form)))
199 :
200 : (defun macroexp--expand-all (form)
201 : "Expand all macros in FORM.
202 : This is an internal version of `macroexpand-all'.
203 : Assumes the caller has bound `macroexpand-all-environment'."
204 1511709 : (if (eq (car-safe form) 'backquote-list*)
205 : ;; Special-case `backquote-list*', as it is normally a macro that
206 : ;; generates exceedingly deep expansions from relatively shallow input
207 : ;; forms. We just process it `in reverse' -- first we expand all the
208 : ;; arguments, _then_ we expand the top-level definition.
209 133 : (macroexpand (macroexp--all-forms form 1)
210 133 : macroexpand-all-environment)
211 : ;; Normal form; get its expansion, and then expand arguments.
212 1511576 : (setq form (macroexp-macroexpand form macroexpand-all-environment))
213 1511576 : (pcase form
214 : (`(cond . ,clauses)
215 774 : (macroexp--cons 'cond (macroexp--all-clauses clauses) form))
216 : (`(condition-case . ,(or `(,err ,body . ,handlers) dontcare))
217 9929 : (macroexp--cons
218 : 'condition-case
219 9929 : (macroexp--cons err
220 9929 : (macroexp--cons (macroexp--expand-all body)
221 9929 : (macroexp--all-clauses handlers 1)
222 9929 : (cddr form))
223 9929 : (cdr form))
224 9929 : form))
225 1945 : (`(,(or `defvar `defconst) . ,_) (macroexp--all-forms form 2))
226 : (`(function ,(and f `(lambda . ,_)))
227 10341 : (macroexp--cons 'function
228 10341 : (macroexp--cons (macroexp--all-forms f 2)
229 : nil
230 10341 : (cdr form))
231 10341 : form))
232 125735 : (`(,(or `function `quote) . ,_) form)
233 : (`(,(and fun (or `let `let*)) . ,(or `(,bindings . ,body) dontcare))
234 50462 : (macroexp--cons fun
235 50462 : (macroexp--cons (macroexp--all-clauses bindings 1)
236 50462 : (macroexp--all-forms body)
237 50462 : (cdr form))
238 50462 : form))
239 : (`(,(and fun `(lambda . ,_)) . ,args)
240 : ;; Embedded lambda in function position.
241 0 : (macroexp--cons (macroexp--all-forms fun 2)
242 0 : (macroexp--all-forms args)
243 0 : form))
244 : ;; The following few cases are for normal function calls that
245 : ;; are known to funcall one of their arguments. The byte
246 : ;; compiler has traditionally handled these functions specially
247 : ;; by treating a lambda expression quoted by `quote' as if it
248 : ;; were quoted by `function'. We make the same transformation
249 : ;; here, so that any code that cares about the difference will
250 : ;; see the same transformation.
251 : ;; First arg is a function:
252 : (`(,(and fun (or `funcall `apply `mapcar `mapatoms `mapconcat `mapc))
253 : ',(and f `(lambda . ,_)) . ,args)
254 0 : (macroexp--warn-and-return
255 0 : (format "%s quoted with ' rather than with #'"
256 0 : (list 'lambda (nth 1 f) '...))
257 0 : (macroexp--expand-all `(,fun ,f . ,args))))
258 : ;; Second arg is a function:
259 : (`(,(and fun (or `sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
260 0 : (macroexp--warn-and-return
261 0 : (format "%s quoted with ' rather than with #'"
262 0 : (list 'lambda (nth 1 f) '...))
263 0 : (macroexp--expand-all `(,fun ,arg1 ,f . ,args))))
264 : (`(funcall #',(and f (pred symbolp)) . ,args)
265 : ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
266 : ;; has a compiler-macro.
267 17 : (macroexp--expand-all `(,f . ,args)))
268 : (`(,func . ,_)
269 : ;; Macro expand compiler macros. This cannot be delayed to
270 : ;; byte-optimize-form because the output of the compiler-macro can
271 : ;; use macros.
272 648589 : (let ((handler (function-get func 'compiler-macro)))
273 648589 : (if (null handler)
274 : ;; No compiler macro. We just expand each argument (for
275 : ;; setq/setq-default this works alright because the variable names
276 : ;; are symbols).
277 639419 : (macroexp--all-forms form 1)
278 : ;; If the handler is not loaded yet, try (auto)loading the
279 : ;; function itself, which may in turn load the handler.
280 9170 : (unless (functionp handler)
281 0 : (with-demoted-errors "macroexp--expand-all: %S"
282 9170 : (autoload-do-load (indirect-function func) func)))
283 9170 : (let ((newform (macroexp--compiler-macro handler form)))
284 9170 : (if (eq form newform)
285 : ;; The compiler macro did not find anything to do.
286 470 : (if (equal form (setq newform (macroexp--all-forms form 1)))
287 300 : form
288 : ;; Maybe after processing the args, some new opportunities
289 : ;; appeared, so let's try the compiler macro again.
290 170 : (setq form (macroexp--compiler-macro handler newform))
291 170 : (if (eq newform form)
292 66 : newform
293 470 : (macroexp--expand-all newform)))
294 648589 : (macroexp--expand-all newform))))))
295 :
296 1511709 : (_ form))))
297 :
298 : ;;;###autoload
299 : (defun macroexpand-all (form &optional environment)
300 : "Return result of expanding macros at all levels in FORM.
301 : If no macros are expanded, FORM is returned unchanged.
302 : The second optional arg ENVIRONMENT specifies an environment of macro
303 : definitions to shadow the loaded ones for use in file byte-compilation."
304 20492 : (let ((macroexpand-all-environment environment))
305 20492 : (macroexp--expand-all form)))
306 :
307 : ;;; Handy functions to use in macros.
308 :
309 : (defun macroexp-parse-body (body)
310 : "Parse a function BODY into (DECLARATIONS . EXPS)."
311 715 : (let ((decls ()))
312 1115 : (while (and (cdr body)
313 554 : (let ((e (car body)))
314 554 : (or (stringp e)
315 355 : (memq (car-safe e)
316 1115 : '(:documentation declare interactive cl-declare)))))
317 800 : (push (pop body) decls))
318 715 : (cons (nreverse decls) body)))
319 :
320 : (defun macroexp-progn (exps)
321 : "Return an expression equivalent to `(progn ,@EXPS)."
322 5344 : (if (cdr exps) `(progn ,@exps) (car exps)))
323 :
324 : (defun macroexp-unprogn (exp)
325 : "Turn EXP into a list of expressions to execute in sequence.
326 : Never returns an empty list."
327 389 : (if (eq (car-safe exp) 'progn) (or (cdr exp) '(nil)) (list exp)))
328 :
329 : (defun macroexp-let* (bindings exp)
330 : "Return an expression equivalent to `(let* ,bindings ,exp)."
331 1760 : (cond
332 1760 : ((null bindings) exp)
333 1025 : ((eq 'let* (car-safe exp)) `(let* (,@bindings ,@(cadr exp)) ,@(cddr exp)))
334 1760 : (t `(let* ,bindings ,exp))))
335 :
336 : (defun macroexp-if (test then else)
337 : "Return an expression equivalent to `(if ,TEST ,THEN ,ELSE)."
338 190 : (cond
339 190 : ((eq (car-safe else) 'if)
340 37 : (cond
341 : ;; Drop this optimization: It's unsafe (it assumes that `test' is
342 : ;; pure, or at least idempotent), and it's not used even a single
343 : ;; time while compiling Emacs's sources.
344 : ;;((equal test (nth 1 else))
345 : ;; ;; Doing a test a second time: get rid of the redundancy.
346 : ;; (message "macroexp-if: sharing 'test' %S" test)
347 : ;; `(if ,test ,then ,@(nthcdr 3 else)))
348 37 : ((equal then (nth 2 else))
349 : ;; (message "macroexp-if: sharing 'then' %S" then)
350 1 : `(if (or ,test ,(nth 1 else)) ,then ,@(nthcdr 3 else)))
351 36 : ((equal (macroexp-unprogn then) (nthcdr 3 else))
352 : ;; (message "macroexp-if: sharing 'then' with not %S" then)
353 3 : `(if (or ,test (not ,(nth 1 else)))
354 3 : ,then ,@(macroexp-unprogn (nth 2 else))))
355 : (t
356 33 : `(cond (,test ,@(macroexp-unprogn then))
357 33 : (,(nth 1 else) ,@(macroexp-unprogn (nth 2 else)))
358 37 : (t ,@(nthcdr 3 else))))))
359 153 : ((eq (car-safe else) 'cond)
360 48 : `(cond (,test ,@(macroexp-unprogn then)) ,@(cdr else)))
361 : ;; Invert the test if that lets us reduce the depth of the tree.
362 105 : ((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then))
363 190 : (t `(if ,test ,then ,@(macroexp-unprogn else)))))
364 :
365 : (defmacro macroexp-let2 (test sym exp &rest body)
366 : "Evaluate BODY with SYM bound to an expression for EXP's value.
367 : The intended usage is that BODY generates an expression that
368 : will refer to EXP's value multiple times, but will evaluate
369 : EXP only once. As BODY generates that expression, it should
370 : use SYM to stand for the value of EXP.
371 :
372 : If EXP is a simple, safe expression, then SYM's value is EXP itself.
373 : Otherwise, SYM's value is a symbol which holds the value produced by
374 : evaluating EXP. The return value incorporates the value of BODY, plus
375 : additional code to evaluate EXP once and save the result so SYM can
376 : refer to it.
377 :
378 : If BODY consists of multiple forms, they are all evaluated
379 : but only the last one's value matters.
380 :
381 : TEST is a predicate to determine whether EXP qualifies as simple and
382 : safe; if TEST is nil, only constant expressions qualify.
383 :
384 : Example:
385 : (macroexp-let2 nil foo EXP
386 : \\=`(* ,foo ,foo))
387 : generates an expression that evaluates EXP once,
388 : then returns the square of that value.
389 : You could do this with
390 : (let ((foovar EXP))
391 : (* foovar foovar))
392 : but using `macroexp-let2' produces more efficient code in
393 : cases where EXP is a constant."
394 : (declare (indent 3) (debug (sexp sexp form body)))
395 4 : (let ((bodysym (make-symbol "body"))
396 4 : (expsym (make-symbol "exp")))
397 4 : `(let* ((,expsym ,exp)
398 4 : (,sym (if (funcall #',(or test #'macroexp-const-p) ,expsym)
399 4 : ,expsym (make-symbol ,(symbol-name sym))))
400 4 : (,bodysym ,(macroexp-progn body)))
401 4 : (if (eq ,sym ,expsym) ,bodysym
402 4 : (macroexp-let* (list (list ,sym ,expsym))
403 4 : ,bodysym)))))
404 :
405 : (defmacro macroexp-let2* (test bindings &rest body)
406 : "Bind each binding in BINDINGS as `macroexp-let2' does."
407 : (declare (indent 2) (debug (sexp (&rest (sexp form)) body)))
408 3 : (pcase-exhaustive bindings
409 1 : (`nil (macroexp-progn body))
410 : (`((,var ,exp) . ,tl)
411 2 : `(macroexp-let2 ,test ,var ,exp
412 3 : (macroexp-let2* ,test ,tl ,@body)))))
413 :
414 : (defun macroexp--maxsize (exp size)
415 40 : (cond ((< size 0) size)
416 28 : ((symbolp exp) (1- size))
417 16 : ((stringp exp) (- size (/ (length exp) 16)))
418 16 : ((vectorp exp)
419 0 : (dotimes (i (length exp))
420 0 : (setq size (macroexp--maxsize (aref exp i) size)))
421 0 : (1- size))
422 16 : ((consp exp)
423 : ;; We could try to be more clever with quote&function,
424 : ;; but it is difficult to do so correctly, and it's not obvious that
425 : ;; it would be worth the effort.
426 12 : (dolist (e exp)
427 36 : (setq size (macroexp--maxsize e size)))
428 12 : (1- size))
429 40 : (t -1)))
430 :
431 : (defun macroexp-small-p (exp)
432 : "Return non-nil if EXP can be considered small."
433 4 : (> (macroexp--maxsize exp 10) 0))
434 :
435 : (defsubst macroexp--const-symbol-p (symbol &optional any-value)
436 : "Non-nil if SYMBOL is constant.
437 : If ANY-VALUE is nil, only return non-nil if the value of the symbol is the
438 : symbol itself."
439 651 : (or (memq symbol '(nil t))
440 591 : (keywordp symbol)
441 585 : (if any-value
442 30 : (or (memq symbol byte-compile-const-variables)
443 : ;; FIXME: We should provide a less intrusive way to find out
444 : ;; if a variable is "constant".
445 30 : (and (boundp symbol)
446 0 : (condition-case nil
447 0 : (progn (set symbol (symbol-value symbol)) nil)
448 651 : (setting-constant t)))))))
449 :
450 : (defun macroexp-const-p (exp)
451 : "Return non-nil if EXP will always evaluate to the same value."
452 1874 : (cond ((consp exp) (or (eq (car exp) 'quote)
453 1484 : (and (eq (car exp) 'function)
454 1553 : (symbolp (cadr exp)))))
455 : ;; It would sometimes make sense to pass `any-value', but it's not
456 : ;; always safe since a "constant" variable may not actually always have
457 : ;; the same value.
458 321 : ((symbolp exp) (macroexp--const-symbol-p exp))
459 1874 : (t t)))
460 :
461 : (defun macroexp-copyable-p (exp)
462 : "Return non-nil if EXP can be copied without extra cost."
463 571 : (or (symbolp exp) (macroexp-const-p exp)))
464 :
465 : (defun macroexp-quote (v)
466 : "Return an expression E such that `(eval E)' is V.
467 :
468 : E is either V or (quote V) depending on whether V evaluates to
469 : itself or not."
470 0 : (if (and (not (consp v))
471 0 : (or (keywordp v)
472 0 : (not (symbolp v))
473 0 : (memq v '(nil t))))
474 0 : v
475 0 : (list 'quote v)))
476 :
477 : ;;; Load-time macro-expansion.
478 :
479 : ;; Because macro-expansion used to be more lazy, eager macro-expansion
480 : ;; tends to bump into previously harmless/unnoticeable cyclic-dependencies.
481 : ;; So, we have to delay macro-expansion like we used to when we detect
482 : ;; such a cycle, and we also want to help coders resolve those cycles (since
483 : ;; they can be non-obvious) by providing a usefully trimmed backtrace
484 : ;; (hopefully) highlighting the problem.
485 :
486 : (defun macroexp--backtrace ()
487 : "Return the Elisp backtrace, more recent frames first."
488 0 : (let ((bt ())
489 : (i 0))
490 0 : (while
491 0 : (let ((frame (backtrace-frame i)))
492 0 : (when frame
493 0 : (push frame bt)
494 0 : (setq i (1+ i)))))
495 0 : (nreverse bt)))
496 :
497 : (defun macroexp--trim-backtrace-frame (frame)
498 0 : (pcase frame
499 0 : (`(,_ macroexpand (,head . ,_) . ,_) `(macroexpand (,head …)))
500 : (`(,_ internal-macroexpand-for-load (,head ,second . ,_) . ,_)
501 0 : (if (or (symbolp second)
502 0 : (and (eq 'quote (car-safe second))
503 0 : (symbolp (cadr second))))
504 0 : `(macroexpand-all (,head ,second …))
505 0 : '(macroexpand-all …)))
506 : (`(,_ load-with-code-conversion ,name . ,_)
507 0 : `(load ,(file-name-nondirectory name)))))
508 :
509 : (defvar macroexp--pending-eager-loads nil
510 : "Stack of files currently undergoing eager macro-expansion.")
511 :
512 : (defvar macroexp--debug-eager nil)
513 :
514 : (defun internal-macroexpand-for-load (form full-p)
515 : ;; Called from the eager-macroexpansion in readevalloop.
516 28513 : (cond
517 : ;; Don't repeat the same warning for every top-level element.
518 28513 : ((eq 'skip (car macroexp--pending-eager-loads)) form)
519 : ;; If we detect a cycle, skip macro-expansion for now, and output a warning
520 : ;; with a trimmed backtrace.
521 28513 : ((and load-file-name (member load-file-name macroexp--pending-eager-loads))
522 0 : (let* ((bt (delq nil
523 0 : (mapcar #'macroexp--trim-backtrace-frame
524 0 : (macroexp--backtrace))))
525 0 : (elem `(load ,(file-name-nondirectory load-file-name)))
526 0 : (tail (member elem (cdr (member elem bt)))))
527 0 : (if tail (setcdr tail (list '…)))
528 0 : (if (eq (car-safe (car bt)) 'macroexpand-all) (setq bt (cdr bt)))
529 0 : (if macroexp--debug-eager
530 0 : (debug 'eager-macroexp-cycle)
531 0 : (message "Warning: Eager macro-expansion skipped due to cycle:\n %s"
532 0 : (mapconcat #'prin1-to-string (nreverse bt) " => ")))
533 0 : (push 'skip macroexp--pending-eager-loads)
534 0 : form))
535 : (t
536 28513 : (condition-case err
537 28513 : (let ((macroexp--pending-eager-loads
538 28513 : (cons load-file-name macroexp--pending-eager-loads)))
539 28513 : (if full-p
540 13948 : (macroexpand-all form)
541 28513 : (macroexpand form)))
542 : (error
543 : ;; Hopefully this shouldn't happen thanks to the cycle detection,
544 : ;; but in case it does happen, let's catch the error and give the
545 : ;; code a chance to macro-expand later.
546 0 : (message "Eager macro-expansion failure: %S" err)
547 28513 : form)))))
548 :
549 : ;; ¡¡¡ Big Ugly Hack !!!
550 : ;; src/bootstrap-emacs is mostly used to compile .el files, so it needs
551 : ;; macroexp, bytecomp, cconv, and byte-opt to be fast. Generally this is done
552 : ;; by compiling those files first, but this only makes a difference if those
553 : ;; files are not preloaded. But macroexp.el is preloaded so we reload it if
554 : ;; the current version is interpreted and there's a compiled version available.
555 : (eval-when-compile
556 : (add-hook 'emacs-startup-hook
557 : (lambda ()
558 : (and (not (byte-code-function-p
559 : (symbol-function 'macroexpand-all)))
560 : (locate-library "macroexp.elc")
561 : (load "macroexp.elc")))))
562 :
563 : (provide 'macroexp)
564 :
565 : ;;; macroexp.el ends here
|