diff options
Diffstat (limited to 'lisp/emacs-lisp/macroexp.el')
| -rw-r--r-- | lisp/emacs-lisp/macroexp.el | 102 |
1 files changed, 78 insertions, 24 deletions
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index bd619bc83b7..797de9abb5b 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -25,7 +25,6 @@ ;; This file contains macro-expansions functions that are not defined in ;; the Lisp core, namely `macroexpand-all', which expands all macros in ;; a form, not just a top-level one. -;; ;;; Code: @@ -97,7 +96,8 @@ each clause." (defun macroexp--compiler-macro (handler form) (condition-case err (apply handler form (cdr form)) - (error (message "Compiler-macro error for %S: %S" (car form) err) + (error + (message "Compiler-macro error for %S: %S" (car form) err) form))) (defun macroexp--funcall-if-compiled (_form) @@ -144,11 +144,55 @@ and also to avoid outputting the warning during normal execution." (instead (format "; use `%s' instead." instead)) (t "."))))) +(defun macroexpand-1 (form &optional environment) + "Perform (at most) one step of macroexpansion." + (cond + ((consp form) + (let* ((head (car form)) + (env-expander (assq head environment))) + (if env-expander + (if (cdr env-expander) + (apply (cdr env-expander) (cdr form)) + form) + (if (not (and (symbolp head) (fboundp head))) + form + (let ((def (autoload-do-load (symbol-function head) head 'macro))) + (cond + ;; Follow alias, but only for macros, otherwise we may end up + ;; skipping an important compiler-macro (e.g. cl--block-wrapper). + ((and (symbolp def) (macrop def)) (cons def (cdr form))) + ((not (consp def)) form) + (t + (if (eq 'macro (car def)) + (apply (cdr def) (cdr form)) + form)))))))) + (t form))) + +(defun macroexp-macroexpand (form env) + "Like `macroexpand' but checking obsolescence." + (let ((new-form + (macroexpand form env))) + (if (and (not (eq form new-form)) ;It was a macro call. + (car-safe form) + (symbolp (car form)) + (get (car form) 'byte-obsolete-info) + (or (not (fboundp 'byte-compile-warning-enabled-p)) + (byte-compile-warning-enabled-p 'obsolete))) + (let* ((fun (car form)) + (obsolete (get fun 'byte-obsolete-info))) + (macroexp--warn-and-return + (macroexp--obsolete-warning + fun obsolete + (if (symbolp (symbol-function fun)) + "alias" "macro")) + new-form)) + new-form))) + (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'." - (if (and (listp form) (eq (car form) 'backquote-list*)) + (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 @@ -156,24 +200,7 @@ Assumes the caller has bound `macroexpand-all-environment'." (macroexpand (macroexp--all-forms form 1) macroexpand-all-environment) ;; Normal form; get its expansion, and then expand arguments. - (let ((new-form - (macroexpand form macroexpand-all-environment))) - (setq form - (if (and (not (eq form new-form)) ;It was a macro call. - (car-safe form) - (symbolp (car form)) - (get (car form) 'byte-obsolete-info) - (or (not (fboundp 'byte-compile-warning-enabled-p)) - (byte-compile-warning-enabled-p 'obsolete))) - (let* ((fun (car form)) - (obsolete (get fun 'byte-obsolete-info))) - (macroexp--warn-and-return - (macroexp--obsolete-warning - fun obsolete - (if (symbolp (symbol-function fun)) - "alias" "macro")) - new-form)) - new-form))) + (setq form (macroexp-macroexpand form macroexpand-all-environment)) (pcase form (`(cond . ,clauses) (macroexp--cons 'cond (macroexp--all-clauses clauses) form)) @@ -225,6 +252,10 @@ 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) + ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo' + ;; has a compiler-macro. + (macroexp--expand-all `(,f . ,args))) (`(,func . ,_) ;; Macro expand compiler macros. This cannot be delayed to ;; byte-optimize-form because the output of the compiler-macro can @@ -238,7 +269,7 @@ Assumes the caller has bound `macroexpand-all-environment'." ;; If the handler is not loaded yet, try (auto)loading the ;; function itself, which may in turn load the handler. (unless (functionp handler) - (ignore-errors + (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) @@ -316,6 +347,15 @@ be skipped; if nil, as is usual, `macroexp-const-p' is used." (macroexp-let* (list (list ,var ,expsym)) ,bodysym))))) +(defmacro macroexp-let2* (test bindings &rest body) + "Bind each binding in BINDINGS as `macroexp-let2' does." + (declare (indent 2) (debug (sexp (&rest (sexp form)) body))) + (pcase-exhaustive bindings + (`nil (macroexp-progn body)) + (`((,var ,exp) . ,tl) + `(macroexp-let2 ,test ,var ,exp + (macroexp-let2* ,test ,tl ,@body))))) + (defun macroexp--maxsize (exp size) (cond ((< size 0) size) ((symbolp exp) (1- size)) @@ -367,6 +407,18 @@ symbol itself." "Return non-nil if EXP can be copied without extra cost." (or (symbolp exp) (macroexp-const-p exp))) +(defun macroexp-quote (v) + "Return an expression E such that `(eval E)' is V. + +E is either V or (quote V) depending on whether V evaluates to +itself or not." + (if (and (not (consp v)) + (or (keywordp v) + (not (symbolp v)) + (memq v '(nil t)))) + v + (list 'quote v))) + ;;; Load-time macro-expansion. ;; Because macro-expansion used to be more lazy, eager macro-expansion @@ -402,7 +454,7 @@ symbol itself." (defvar macroexp--pending-eager-loads nil "Stack of files currently undergoing eager macro-expansion.") -(defun internal-macroexpand-for-load (form) +(defun internal-macroexpand-for-load (form full-p) ;; Called from the eager-macroexpansion in readevalloop. (cond ;; Don't repeat the same warning for every top-level element. @@ -425,7 +477,9 @@ symbol itself." (condition-case err (let ((macroexp--pending-eager-loads (cons load-file-name macroexp--pending-eager-loads))) - (macroexpand-all form)) + (if full-p + (macroexpand-all form) + (macroexpand form))) (error ;; Hopefully this shouldn't happen thanks to the cycle detection, ;; but in case it does happen, let's catch the error and give the |