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'."
  ;; Note that this function must preserve any position on FORM in the
  ;; function's return value.  See the page "Symbols with Position" in
  ;; the elisp manual.
  (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) . ,args)
             (if (and (car-safe args) (symbolp (car-safe args)))
                 (progn
                   (push (car args) macroexp--dynvars)
                   (macroexp--all-forms form 2))
               form))
            (`(function . ,rest)
             (if (and (eq (car-safe (car-safe rest)) 'lambda)
                      (null (cdr rest)))
                 (let ((f (car rest)))
                   (let ((macroexp--dynvars macroexp--dynvars))
                     (macroexp--cons fn
                                     (macroexp--cons (macroexp--all-forms f 2)
                                                     nil
                                                     (cdr form))
                                     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 . ,args)
             (if args
                 (macroexp--all-forms form 1)
               (macroexp-warn-and-return
                (format-message "missing `while' condition")
                `(signal 'wrong-number-of-arguments '(while 0))
                nil 'compile-only form)))
            (`(unwind-protect . ,args)
             (if (cdr-safe args)
                 (macroexp--all-forms form 1)
               (macroexp-warn-and-return
                (format-message "`unwind-protect' without unwind forms")
                (macroexp--expand-all (car-safe args))
                (list 'suspicious 'unwind-protect) t form)))
            (`(setq . ,args)
             (let ((nargs (length args))
                   (var (car-safe args)))
               (if (and (= nargs 2)
                        (symbolp var)
                        (not (booleanp var)) (not (keywordp var)))
                   ;; Fast path for the common case.
                   (let* ((expr (nth 1 args))
                          (new-expr (macroexp--expand-all expr)))
                     (if (eq new-expr expr)
                         form
                       `(,fn ,var ,new-expr)))
                 ;; Normalize to a sequence of (setq SYM EXPR).
                 ;; Malformed code is translated to code that signals an error
                 ;; at run time.
                 (if (oddp nargs)
                     (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.
                                    ;; FIXME: Why, exactly? It's useless.
                                    `(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)))))))
            (`(funcall ,exp . ,args)
             (let ((eexp (macroexp--expand-all exp))
                   (eargs (macroexp--all-forms args)))
               (if (eq (car-safe eexp) 'function)
                   (let ((f (cadr eexp)))
                     (cond
                      ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
                      ;; has a compiler-macro, or to unfold it.
                      ((and (symbolp f)
                            ;; bug#46636
                            (not (or (special-form-p f) (macrop f))))
                       (macroexp--expand-all `(,f . ,eargs)))
                      ((eq (car-safe f) 'lambda)
                       (macroexp--unfold-lambda `(,fn ,eexp . ,eargs)))
                      (t `(,fn ,eexp . ,eargs))))
                 `(,fn ,eexp . ,eargs))))
            (`(funcall . ,_) form)      ;bug#53227
            (`(,(and func (pred symbolp)) . ,_)
             (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))))))
            (`(,(and fun `(lambda . ,_)) . ,args)
	     (macroexp--cons (macroexp--all-forms fun 2)
                             (macroexp--all-forms args)
                             form))
            (_ form))))))