Function: macroexp--expand-all
macroexp--expand-all is a byte-compiled function defined in
macroexp.el.gz.
Signature
(macroexp--expand-all FORM)
Documentation
Expand all macros in FORM.
This is an internal version of macroexpand-all.
Assumes the caller has bound macroexpand-all-environment.
Source Code
;; Defined in /usr/src/emacs/lisp/emacs-lisp/macroexp.el.gz
(defun macroexp--expand-all (form)
"Expand all macros in FORM.
This is an internal version of `macroexpand-all'.
Assumes the caller has bound `macroexpand-all-environment'."
(macroexp--with-extended-form-stack form
(if (eq (car-safe form) 'backquote-list*)
;; Special-case `backquote-list*', as it is normally a macro that
;; generates exceedingly deep expansions from relatively shallow input
;; forms. We just process it `in reverse' -- first we expand all the
;; arguments, _then_ we expand the top-level definition.
(macroexpand (macroexp--all-forms form 1)
macroexpand-all-environment)
;; Normal form; get its expansion, and then expand arguments.
(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 :-(
(let ((fn (car-safe form)))
(pcase form
(`(cond . ,clauses)
;; Check for rubbish clauses at the end before macro-expansion,
;; to avoid nuisance warnings from clauses that become
;; unconditional through that process.
;; FIXME: this strategy is defeated by forced `macroexpand-all',
;; such as in `cl-flet'. Haven't seen that in the wild, though.
(let ((default-tail nil)
(n 0)
(rest clauses))
(while (cdr rest)
(let ((c (car-safe (car rest))))
(when (cond ((consp c) (and (memq (car c) '(quote function))
(cadr c)))
((symbolp c) (or (eq c t) (keywordp c)))
(t t))
;; This is unquestionably a default clause.
(setq default-tail (cdr rest))
(setq clauses (take (1+ n) clauses)) ; trim the tail
(setq rest nil)))
(setq n (1+ n))
(setq rest (cdr rest)))
(let ((expanded-form
(macroexp--cons fn (macroexp--all-clauses clauses) form)))
(if default-tail
(macroexp-warn-and-return
(format-message
"Useless clause following default `cond' clause")
expanded-form '(suspicious cond) t default-tail)
expanded-form))))
(`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare))
(let ((exp-body (macroexp--expand-all body)))
(if handlers
(macroexp--cons fn
(macroexp--cons
err (macroexp--cons
exp-body
(macroexp--all-clauses handlers 1)
(cddr form))
(cdr form))
form)
(macroexp-warn-and-return
(format-message "`condition-case' without handlers")
exp-body (list 'suspicious 'condition-case) t 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-message "`%s' with empty body" fun)
nil (list 'empty-body fun) 'compile-only fun))
(macroexp--all-forms body))
(cdr form))
form)))
(`(while)
(macroexp-warn-and-return
(format-message "missing `while' condition")
`(signal 'wrong-number-of-arguments '(while 0))
nil 'compile-only form))
(`(unwind-protect ,expr)
(macroexp-warn-and-return
(format-message "`unwind-protect' without unwind forms")
(macroexp--expand-all expr)
(list 'suspicious 'unwind-protect) t form))
(`(setq ,(and var (pred symbolp)
(pred (not booleanp)) (pred (not keywordp)))
,expr)
;; Fast path for the setq common case.
(let ((new-expr (macroexp--expand-all expr)))
(if (eq new-expr expr)
form
`(,fn ,var ,new-expr))))
(`(setq . ,args)
;; Normalize to a sequence of (setq SYM EXPR).
;; Malformed code is translated to code that signals an error
;; at run time.
(let ((nargs (length args)))
(if (/= (logand nargs 1) 0)
(macroexp-warn-and-return
(format-message "odd number of arguments in `setq' form")
`(signal 'wrong-number-of-arguments '(setq ,nargs))
nil 'compile-only fn)
(let ((assignments nil))
(while (consp (cdr-safe args))
(let* ((var (car args))
(expr (cadr args))
(new-expr (macroexp--expand-all expr))
(assignment
(if (and (symbolp var)
(not (booleanp var)) (not (keywordp var)))
`(,fn ,var ,new-expr)
(macroexp-warn-and-return
(format-message "attempt to set %s `%s'"
(if (symbolp var)
"constant"
"non-variable")
var)
(cond
((keywordp var)
;; Accept `(setq :a :a)' for compatibility.
`(if (eq ,var ,new-expr)
,var
(signal 'setting-constant (list ',var))))
((symbolp var)
`(signal 'setting-constant (list ',var)))
(t
`(signal 'wrong-type-argument
(list 'symbolp ',var))))
nil 'compile-only var))))
(push assignment assignments))
(setq args (cddr args)))
(cons 'progn (nreverse assignments))))))
(`(,(and fun `(lambda . ,_)) . ,args)
(macroexp--cons (macroexp--all-forms fun 2)
(macroexp--all-forms args)
form))
(`(funcall ,exp . ,args)
(let ((eexp (macroexp--expand-all exp))
(eargs (macroexp--all-forms args)))
(pcase eexp
;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
;; has a compiler-macro, or to unfold it.
((and `#',f
(guard (and (symbolp f)
;; bug#46636
(not (or (special-form-p f) (macrop f))))))
(macroexp--expand-all `(,f . ,eargs)))
(`#'(lambda . ,_)
(macroexp--unfold-lambda `(,fn ,eexp . ,eargs)))
(_ `(,fn ,eexp . ,eargs)))))
(`(funcall . ,_) form) ;bug#53227
(`(,func . ,_)
(let ((handler (function-get func 'compiler-macro)))
;; 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.
(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 form)))
(macroexp--expand-all newform))))))
(_ form))))))