From: Mattias Engdegård Date: Thu, 21 Dec 2023 12:33:27 +0000 (+0100) Subject: Encapsulate byte-compile-form-stack maintenance X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9db1fe638ecfdd2d8dd32e3ee47f97c5ed3312c1;p=emacs.git Encapsulate byte-compile-form-stack maintenance * lisp/emacs-lisp/bytecomp.el (byte-compile-toplevel-file-form) (byte-compile-form): * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Use `macroexp--with-extended-form-stack` instead of explicit push and pop. --- diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 950ae77803c..d2f1e6886ef 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2663,16 +2663,12 @@ list that represents a doc string reference. ;; byte-hunk-handlers cannot call this! (defun byte-compile-toplevel-file-form (top-level-form) - ;; (let ((byte-compile-form-stack - ;; (cons top-level-form byte-compile-form-stack))) - (push top-level-form byte-compile-form-stack) - (prog1 - (byte-compile-recurse-toplevel - top-level-form - (lambda (form) - (let ((byte-compile-current-form nil)) ; close over this for warnings. - (byte-compile-file-form (byte-compile-preprocess form t))))) - (pop byte-compile-form-stack))) + (macroexp--with-extended-form-stack top-level-form + (byte-compile-recurse-toplevel + top-level-form + (lambda (form) + (let ((byte-compile-current-form nil)) ; close over this for warnings. + (byte-compile-file-form (byte-compile-preprocess form t))))))) ;; byte-hunk-handlers can call this. (defun byte-compile-file-form (form) @@ -3483,122 +3479,121 @@ lambda-expression." ;; (defun byte-compile-form (form &optional for-effect) (let ((byte-compile--for-effect for-effect)) - (push form byte-compile-form-stack) - (cond - ((not (consp form)) - (cond ((or (not (symbolp form)) (macroexp--const-symbol-p form)) - (byte-compile-constant form)) - ((and byte-compile--for-effect byte-compile-delete-errors) - (setq byte-compile--for-effect nil)) - (t (byte-compile-variable-ref form)))) - ((symbolp (car form)) - (let* ((fn (car form)) - (handler (get fn 'byte-compile)) - (interactive-only - (or (function-get fn 'interactive-only) - (memq fn byte-compile-interactive-only-functions)))) - (when (memq fn '(set symbol-value run-hooks ;; add-to-list - add-hook remove-hook run-hook-with-args - run-hook-with-args-until-success - run-hook-with-args-until-failure)) - (pcase (cdr form) - (`(',var . ,_) - (when (and (memq var byte-compile-lexical-variables) - (byte-compile-warning-enabled-p 'lexical var)) - (byte-compile-warn - (format-message "%s cannot use lexical var `%s'" fn var)))))) - ;; Warn about using obsolete hooks. - (if (memq fn '(add-hook remove-hook)) - (let ((hook (car-safe (cdr form)))) - (if (eq (car-safe hook) 'quote) - (byte-compile-check-variable (cadr hook) nil)))) - (when (and (byte-compile-warning-enabled-p 'suspicious) - (macroexp--const-symbol-p fn)) - (byte-compile-warn-x fn "`%s' called as a function" fn)) - (when (and (byte-compile-warning-enabled-p 'interactive-only fn) - interactive-only) - (byte-compile-warn-x fn "`%s' is for interactive use only%s" - fn - (cond ((stringp interactive-only) - (format "; %s" - (substitute-command-keys - interactive-only))) - ((and (symbolp interactive-only) - (not (eq interactive-only t))) - (format-message "; use `%s' instead." - interactive-only)) - (t ".")))) - (let ((mutargs (function-get (car form) 'mutates-arguments))) - (when mutargs - (dolist (idx (if (eq mutargs 'all-but-last) - (number-sequence 1 (- (length form) 2)) - mutargs)) - (let ((arg (nth idx form))) - (when (and (or (and (eq (car-safe arg) 'quote) - (consp (nth 1 arg))) - (arrayp arg)) - (byte-compile-warning-enabled-p - 'mutate-constant (car form))) - (byte-compile-warn-x form "`%s' on constant %s (arg %d)" - (car form) - (if (consp arg) "list" (type-of arg)) - idx)))))) - - (let ((funargs (function-get (car form) 'funarg-positions))) - (dolist (funarg funargs) - (let ((arg (if (numberp funarg) - (nth funarg form) - (cadr (memq funarg form))))) - (when (and (eq 'quote (car-safe arg)) - (eq 'lambda (car-safe (cadr arg)))) + (macroexp--with-extended-form-stack form + (cond + ((not (consp form)) + (cond ((or (not (symbolp form)) (macroexp--const-symbol-p form)) + (byte-compile-constant form)) + ((and byte-compile--for-effect byte-compile-delete-errors) + (setq byte-compile--for-effect nil)) + (t (byte-compile-variable-ref form)))) + ((symbolp (car form)) + (let* ((fn (car form)) + (handler (get fn 'byte-compile)) + (interactive-only + (or (function-get fn 'interactive-only) + (memq fn byte-compile-interactive-only-functions)))) + (when (memq fn '(set symbol-value run-hooks ;; add-to-list + add-hook remove-hook run-hook-with-args + run-hook-with-args-until-success + run-hook-with-args-until-failure)) + (pcase (cdr form) + (`(',var . ,_) + (when (and (memq var byte-compile-lexical-variables) + (byte-compile-warning-enabled-p 'lexical var)) + (byte-compile-warn + (format-message "%s cannot use lexical var `%s'" fn var)))))) + ;; Warn about using obsolete hooks. + (if (memq fn '(add-hook remove-hook)) + (let ((hook (car-safe (cdr form)))) + (if (eq (car-safe hook) 'quote) + (byte-compile-check-variable (cadr hook) nil)))) + (when (and (byte-compile-warning-enabled-p 'suspicious) + (macroexp--const-symbol-p fn)) + (byte-compile-warn-x fn "`%s' called as a function" fn)) + (when (and (byte-compile-warning-enabled-p 'interactive-only fn) + interactive-only) + (byte-compile-warn-x fn "`%s' is for interactive use only%s" + fn + (cond ((stringp interactive-only) + (format "; %s" + (substitute-command-keys + interactive-only))) + ((and (symbolp interactive-only) + (not (eq interactive-only t))) + (format-message "; use `%s' instead." + interactive-only)) + (t ".")))) + (let ((mutargs (function-get (car form) 'mutates-arguments))) + (when mutargs + (dolist (idx (if (eq mutargs 'all-but-last) + (number-sequence 1 (- (length form) 2)) + mutargs)) + (let ((arg (nth idx form))) + (when (and (or (and (eq (car-safe arg) 'quote) + (consp (nth 1 arg))) + (arrayp arg)) + (byte-compile-warning-enabled-p + 'mutate-constant (car form))) + (byte-compile-warn-x form "`%s' on constant %s (arg %d)" + (car form) + (if (consp arg) "list" (type-of arg)) + idx)))))) + + (let ((funargs (function-get (car form) 'funarg-positions))) + (dolist (funarg funargs) + (let ((arg (if (numberp funarg) + (nth funarg form) + (cadr (memq funarg form))))) + (when (and (eq 'quote (car-safe arg)) + (eq 'lambda (car-safe (cadr arg)))) + (byte-compile-warn-x + arg "(lambda %s ...) quoted with %s rather than with #%s" + (or (nth 1 (cadr arg)) "()") + "'" "'"))))) ; avoid styled quotes + + (if (eq (car-safe (symbol-function (car form))) 'macro) + (byte-compile-report-error + (format-message "`%s' defined after use in %S (missing `require' of a library file?)" + (car form) form))) + + (when byte-compile--for-effect + (let ((sef (function-get (car form) 'side-effect-free))) + (cond + ((and sef (or (eq sef 'error-free) + byte-compile-delete-errors)) + ;; This transform is normally done in the Lisp optimizer, + ;; so maybe we don't need to bother about it here? + (setq form (cons 'progn (cdr form))) + (setq handler #'byte-compile-progn)) + ((and (or sef (function-get (car form) 'important-return-value)) + ;; Don't warn for arguments to `ignore'. + (not (eq byte-compile--for-effect 'for-effect-no-warn)) + (byte-compile-warning-enabled-p + 'ignored-return-value (car form))) (byte-compile-warn-x - arg "(lambda %s ...) quoted with %s rather than with #%s" - (or (nth 1 (cadr arg)) "()") - "'" "'"))))) ; avoid styled quotes - - (if (eq (car-safe (symbol-function (car form))) 'macro) - (byte-compile-report-error - (format-message "`%s' defined after use in %S (missing `require' of a library file?)" - (car form) form))) - - (when byte-compile--for-effect - (let ((sef (function-get (car form) 'side-effect-free))) - (cond - ((and sef (or (eq sef 'error-free) - byte-compile-delete-errors)) - ;; This transform is normally done in the Lisp optimizer, - ;; so maybe we don't need to bother about it here? - (setq form (cons 'progn (cdr form))) - (setq handler #'byte-compile-progn)) - ((and (or sef (function-get (car form) 'important-return-value)) - ;; Don't warn for arguments to `ignore'. - (not (eq byte-compile--for-effect 'for-effect-no-warn)) - (byte-compile-warning-enabled-p - 'ignored-return-value (car form))) - (byte-compile-warn-x - (car form) - "value from call to `%s' is unused%s" - (car form) - (cond ((eq (car form) 'mapcar) - "; use `mapc' or `dolist' instead") - (t ""))))))) - - (if (and handler - ;; Make sure that function exists. - (and (functionp handler) - ;; Ignore obsolete byte-compile function used by former - ;; CL code to handle compiler macros (we do it - ;; differently now). - (not (eq handler 'cl-byte-compile-compiler-macro)))) - (funcall handler form) - (byte-compile-normal-call form)))) - ((and (byte-code-function-p (car form)) - (memq byte-optimize '(t lap))) - (byte-compile-unfold-bcf form)) - ((byte-compile-normal-call form))) - (if byte-compile--for-effect - (byte-compile-discard)) - (pop byte-compile-form-stack))) + (car form) + "value from call to `%s' is unused%s" + (car form) + (cond ((eq (car form) 'mapcar) + "; use `mapc' or `dolist' instead") + (t ""))))))) + + (if (and handler + ;; Make sure that function exists. + (and (functionp handler) + ;; Ignore obsolete byte-compile function used by former + ;; CL code to handle compiler macros (we do it + ;; differently now). + (not (eq handler 'cl-byte-compile-compiler-macro)))) + (funcall handler form) + (byte-compile-normal-call form)))) + ((and (byte-code-function-p (car form)) + (memq byte-optimize '(t lap))) + (byte-compile-unfold-bcf form)) + ((byte-compile-normal-call form))) + (if byte-compile--for-effect + (byte-compile-discard))))) (let ((important-return-value-fns '( diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 2a646be9725..78601c0648e 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -334,8 +334,7 @@ Only valid during macro-expansion." "Expand all macros in FORM. This is an internal version of `macroexpand-all'. Assumes the caller has bound `macroexpand-all-environment'." - (push form byte-compile-form-stack) - (prog1 + (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 @@ -520,8 +519,7 @@ Assumes the caller has bound `macroexpand-all-environment'." newform (macroexp--expand-all form))) (macroexp--expand-all newform)))))) - (_ form)))) - (pop byte-compile-form-stack))) + (_ form)))))) ;;;###autoload (defun macroexpand-all (form &optional environment)