master 9db1fe638ec 1/2: Encapsulate byte-compile-form-stack maintenance

[Mattias Engdegård]

branch: master
commit 9db1fe638ecfdd2d8dd32e3ee47f97c5ed3312c1
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    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.
---
 lisp/emacs-lisp/bytecomp.el | 245 ++++++++++++++++++++++----------------------
 lisp/emacs-lisp/macroexp.el |   6 +-
 2 files changed, 122 insertions(+), 129 deletions(-)

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)