Commit fixes and enhancements to the scratch/correct-warning-pos branch

No longer strip positions from symbols before each use of a form, instead
relying on the low level C routines to do the right thing.  Instead strip them
from miscellaneous places where this is needed.  Stip them alson in
`function-put'.

Push forms onto byte-compile-form-stack and pop them "by hand" rather than by
binding the variable at each pushing, so that it will still have its data
after an error has been thrown and caught by a condition case.  This gives an
source position to the ensuing error message.

* lisp/emacs-lisp/byte-run.el (byte-run--ssp-seen, byte-run--circular-list-p)
(byte-run--strip-s-p-1, byte-run-strip-symbol-positions): New functions and
variables, which together implement stripping of symbol positions.  The latest
(?final) version modifies the argument in place rather than making a copy.
(function-put): Strip symbol positions from all of the arguments before doing
the `put'.

* lisp/emacs-lisp/bytecomp.el (byte-compile--form-stack): has been renamed to
byte-compile-form-stack and moved to macroexp.el.
(byte-compile-initial-macro-environment (eval-and-compile)): Replace
macroexpand-all-toplevel with macroexpand--all-toplevel.
(displaying-byte-compile-warnings): bind byte-compile-form-stack here.
(byte-compile-toplevel-file-form, byte-compile-form): Push the top level form
onto byte-compile-form-stack (whereas formally the variable was bound at each
pushing).  Manually pop this from of the variable at the end of the function.

* lisp/emacs-lisp/cl-macs.el (cl-define-compiler-macro): Remove the symbol
stripping.

* lisp/emacs-lisp/comp.el (comp--native-compile): Set max-specpdl-size to at
least 5000 (previously it was 2500).  Bind print-symbols-bare to t.

* lisp/emacs-lisp/macroexp.el (byte-compile-form-stack): Definition move here
from bytecomp.el for easier compilation.
(byte-compile-strip-symbol-positions and associated functions): Removed.
(macro--expand-all): push argument FORM onto byte-compile-form-stack at the
start of this function, and pop it off at the end.
(internal-macroexpand-for-load): No longer strip symbol positions.  Bind
symbols-with-pos-enabled and print-symbols-bare to t.

* lisp/help.el (help--make-usage): Strip any position from argument ARG.

* src/fns.c (Fput): No longer strip symbol positions from any of the
arguments.

1 files changed, 50 insertions, 66 deletions

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index b3197a97021..7ddca19626e 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -460,12 +460,6 @@ Filled in `cconv-analyze-form' but initialized and consulted here.")
 
 (defvar byte-compiler-error-flag)
 
-(defvar byte-compile--form-stack nil
-  "Dynamic list of successive enclosing forms.
-This is used by the warning message routines to determine a
-source code position.  The most accessible element is the current
-most deeply nested form.")
-
 (defun byte-compile-recurse-toplevel (form non-toplevel-case)
   "Implement `eval-when-compile' and `eval-and-compile'.
 Return the compile-time value of FORM."
@@ -506,9 +500,8 @@ Return the compile-time value of FORM."
                                         byte-compile-new-defuns))
                                    (setf result
                                          (byte-compile-eval
-                                          (macroexp-strip-symbol-positions
                                            (byte-compile-top-level
-                                            (byte-compile-preprocess form))))))))
+                                            (byte-compile-preprocess form)))))))
                               (list 'quote result))))
     (eval-and-compile . ,(lambda (&rest body)
                            (byte-compile-recurse-toplevel
@@ -517,10 +510,11 @@ Return the compile-time value of FORM."
                               ;; Don't compile here, since we don't know
                               ;; whether to compile as byte-compile-form
                               ;; or byte-compile-file-form.
-                              (let ((expanded
-                                     (macroexpand--all-toplevel
-                                      form
-                                      macroexpand-all-environment)))
+                              (let* ((print-symbols-bare t)
+                                     (expanded
+                                      (macroexpand--all-toplevel
+                                       form
+                                       macroexpand-all-environment)))
                                 (eval expanded lexical-binding)
                                 expanded)))))
     (with-suppressed-warnings
@@ -1248,10 +1242,10 @@ Here, \"first\" is by a depth first search."
      (t 0))))
 
 (defun byte-compile--warning-source-offset ()
-  "Return a source offset from `byte-compile--form-stack'.
+  "Return a source offset from `byte-compile-form-stack'.
 Return nil if such is not found."
   (catch 'offset
-    (dolist (form byte-compile--form-stack)
+    (dolist (form byte-compile-form-stack)
       (let ((s (byte-compile--first-symbol form)))
         (if (symbol-with-pos-p s)
             (throw 'offset (symbol-with-pos-pos s)))))))
@@ -1406,7 +1400,6 @@ function directly; use `byte-compile-warn' or
 
 (defun byte-compile-warn (format &rest args)
   "Issue a byte compiler warning; use (format-message FORMAT ARGS...) for message."
-  (setq args (mapcar #'macroexp-strip-symbol-positions args))
   (setq format (apply #'format-message format args))
   (if byte-compile-error-on-warn
       (error "%s" format)		; byte-compile-file catches and logs it
@@ -1417,7 +1410,7 @@ function directly; use `byte-compile-warn' or
 ARG is the source element (likely a symbol with position) central to
   the warning, intended to supply source position information.
 FORMAT and ARGS are as in `byte-compile-warn'."
-  (let ((byte-compile--form-stack (cons arg byte-compile--form-stack)))
+  (let ((byte-compile-form-stack (cons arg byte-compile-form-stack)))
     (apply #'byte-compile-warn format args)))
 
 (defun byte-compile-warn-obsolete (symbol)
@@ -1867,7 +1860,8 @@ It is too wide if it has any lines longer than the largest of
 	  (warning-series-started
 	   (and (markerp warning-series)
 		(eq (marker-buffer warning-series)
-		    (get-buffer byte-compile-log-buffer)))))
+		    (get-buffer byte-compile-log-buffer))))
+          (byte-compile-form-stack byte-compile-form-stack))
      (if (or (eq warning-series 'byte-compile-warning-series)
 	     warning-series-started)
 	 ;; warning-series does come from compilation,
@@ -2257,10 +2251,7 @@ See also `emacs-lisp-byte-compile-and-load'."
 	            (write-region (point-min) (point-max) dynvar-file)))))
 	    (if load
                 (load target-file))
-	    t)))
-    ;; Strip positions from symbols for the native compiler.
-    (setq byte-to-native-top-level-forms
-          (macroexp-strip-symbol-positions byte-to-native-top-level-forms))))
+	    t)))))
 
 ;;; compiling a single function
 ;;;###autoload
@@ -2272,7 +2263,8 @@ With argument ARG, insert value in current buffer after the form."
   (save-excursion
     (end-of-defun)
     (beginning-of-defun)
-    (let* ((byte-compile-current-file (current-buffer))
+    (let* ((print-symbols-bare t)
+           (byte-compile-current-file (current-buffer))
 	   (byte-compile-current-buffer (current-buffer))
 	   (byte-compile-read-position (point))
 	   (byte-compile-last-position byte-compile-read-position)
@@ -2319,7 +2311,7 @@ With argument ARG, insert value in current buffer after the form."
 	(read-symbol-positions-list nil)
 	;;	  #### This is bound in b-c-close-variables.
 	;;	  (byte-compile-warnings byte-compile-warnings)
-	)
+        (symbols-with-pos-enabled t))
     (byte-compile-close-variables
      (with-current-buffer
          (setq byte-compile--outbuffer
@@ -2432,11 +2424,10 @@ Call from the source buffer."
   ;; it here.
   (when byte-native-compiling
     ;; Spill output for the native compiler here
-    (push
-     (macroexp-strip-symbol-positions
-      (make-byte-to-native-top-level :form form :lexical lexical-binding))
-     byte-to-native-top-level-forms))
-  (let ((print-escape-newlines t)
+    (push (make-byte-to-native-top-level :form form :lexical lexical-binding)
+          byte-to-native-top-level-forms))
+  (let ((print-symbols-bare t)
+        (print-escape-newlines t)
         (print-length nil)
         (print-level nil)
         (print-quoted t)
@@ -2471,8 +2462,8 @@ list that represents a doc string reference.
   ;; in the input buffer (now current), not in the output buffer.
   (let ((dynamic-docstrings byte-compile-dynamic-docstrings))
     (with-current-buffer byte-compile--outbuffer
-      (let (position)
-
+      (let (position
+            (print-symbols-bare t))
         ;; Insert the doc string, and make it a comment with #@LENGTH.
         (and (>= (nth 1 info) 0)
              dynamic-docstrings
@@ -2596,13 +2587,16 @@ 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)))
-    (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)))))))
+  ;; (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)))
 
 ;; byte-hunk-handlers can call this.
 (defun byte-compile-file-form (form)
@@ -2635,8 +2629,7 @@ list that represents a doc string reference.
      ;; byte-compile-noruntime-functions, in case we have an autoload
      ;; of foo-func following an (eval-when-compile (require 'foo)).
      (unless (fboundp funsym)
-       (push (macroexp-strip-symbol-positions
-              (cons funsym (cons 'autoload (cdr (cdr form)))))
+       (push (cons funsym (cons 'autoload (cdr (cdr form))))
              byte-compile-function-environment))
      ;; If an autoload occurs _before_ the first call to a function,
      ;; byte-compile-callargs-warn does not add an entry to
@@ -2652,7 +2645,8 @@ list that represents a doc string reference.
              (delq (assq funsym byte-compile-unresolved-functions)
                    byte-compile-unresolved-functions)))))
   (if (stringp (nth 3 form))
-      (prog1 (macroexp-strip-symbol-positions form)
+      (prog1
+          form
         (byte-compile-docstring-length-warn form))
     ;; No doc string, so we can compile this as a normal form.
     (byte-compile-keep-pending form 'byte-compile-normal-call)))
@@ -2692,8 +2686,7 @@ list that represents a doc string reference.
                    (byte-compile-top-level (nth 2 form) nil 'file)))
           ((symbolp (nth 2 form))
            (setcar (cddr form) (bare-symbol (nth 2 form))))
-          (t (setcar (cddr form)
-                     (macroexp-strip-symbol-positions (nth 2 form)))))
+          (t (setcar (cddr form) (nth 2 form))))
     (setcar form (bare-symbol (car form)))
     (if (symbolp (nth 1 form))
         (setcar (cdr form) (bare-symbol (nth 1 form))))
@@ -2775,8 +2768,7 @@ list that represents a doc string reference.
 (defun byte-compile-file-form-make-obsolete (form)
   (prog1 (byte-compile-keep-pending form)
     (apply 'make-obsolete
-           (mapcar 'eval
-                   (macroexp-strip-symbol-positions (cdr form))))))
+           (mapcar 'eval (cdr form)))))
 
 (defun byte-compile-file-form-defmumble (name macro arglist body rest)
   "Process a `defalias' for NAME.
@@ -2894,14 +2886,13 @@ not to take responsibility for the actual compilation of the code."
             (when byte-native-compiling
               ;; Spill output for the native compiler here.
               (push
-               (macroexp-strip-symbol-positions
                 (if macro
                     (make-byte-to-native-top-level
                      :form `(defalias ',name '(macro . ,code) nil)
                      :lexical lexical-binding)
                   (make-byte-to-native-func-def :name name
-                                                :byte-func code)))
-               byte-to-native-top-level-forms))
+                                                :byte-func code))
+                byte-to-native-top-level-forms))
             ;; Output the form by hand, that's much simpler than having
             ;; b-c-output-file-form analyze the defalias.
             (byte-compile-output-docform
@@ -3020,9 +3011,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
                   (setq fun (eval fun t)))
               (if macro (push 'macro fun))
               (if (symbolp form) (fset form fun))
-              fun)))
-        (setq byte-to-native-top-level-forms
-              (macroexp-strip-symbol-positions byte-to-native-top-level-forms)))))))
+              fun))))))))
 
 (defun byte-compile-sexp (sexp)
   "Compile and return SEXP."
@@ -3169,8 +3158,7 @@ for symbols generated by the byte compiler itself."
                        ;; which may include "calls" to
                        ;; internal-make-closure (Bug#29988).
                        lexical-binding)
-                   (setq int (macroexp-strip-symbol-positions `(interactive ,newform)))
-                 (setq int (macroexp-strip-symbol-positions int)))))
+                   (setq int `(interactive ,newform)))))
             ((cdr int)                  ; Invalid (interactive . something).
 	     (byte-compile-warn-x int "malformed interactive spec: %s"
 				  int))))
@@ -3185,7 +3173,7 @@ for symbols generated by the byte compiler itself."
                                         (byte-compile-make-lambda-lexenv
                                          arglistvars))
                                    reserved-csts))
-          (bare-arglist (macroexp-strip-symbol-positions arglist)))
+          (bare-arglist arglist))
       ;; Build the actual byte-coded function.
       (cl-assert (eq 'byte-code (car-safe compiled)))
       (let ((out
@@ -3208,9 +3196,7 @@ for symbols generated by the byte compiler itself."
 		     (cond
 		      ;; We have some command modes, so use the vector form.
 		      (command-modes
-                       (list (vector (nth 1 int)
-                                     (macroexp-strip-symbol-positions
-                                      command-modes))))
+                       (list (vector (nth 1 int) command-modes)))
 		      ;; No command modes, use the simple form with just the
 		      ;; interactive spec.
 		      (int
@@ -3425,8 +3411,8 @@ for symbols generated by the byte compiler itself."
 ;; byte-compile--for-effect flag too.)
 ;;
 (defun byte-compile-form (form &optional for-effect)
-  (let ((byte-compile--for-effect for-effect)
-        (byte-compile--form-stack (cons form byte-compile--form-stack)))
+  (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))
@@ -3500,7 +3486,8 @@ for symbols generated by the byte compiler itself."
       (setq byte-compile--for-effect nil))
      ((byte-compile-normal-call form)))
     (if byte-compile--for-effect
-        (byte-compile-discard))))
+        (byte-compile-discard))
+    (pop byte-compile-form-stack)))
 
 (defun byte-compile-normal-call (form)
   (when (and (symbolp (car form))
@@ -3756,8 +3743,7 @@ assignment (i.e. `setq')."
     (setq const (bare-symbol const)))
   (byte-compile-out
    'byte-constant
-   (byte-compile-get-constant
-    (macroexp-strip-symbol-positions const))))
+   (byte-compile-get-constant const)))
 
 ;; Compile those primitive ordinary functions
 ;; which have special byte codes just for speed.
@@ -4591,7 +4577,7 @@ Return (TAIL VAR TEST CASES), where:
 
     (dolist (case cases)
       (setq tag (byte-compile-make-tag)
-            test-objects (macroexp-strip-symbol-positions (car case))
+            test-objects (car case)
             body (cdr case))
       (byte-compile-out-tag tag)
       (dolist (value test-objects)
@@ -5241,9 +5227,9 @@ OP and OPERAND are as passed to `byte-compile-out'."
 ;;; call tree stuff
 
 (defun byte-compile-annotate-call-tree (form)
-  (let ((current-form (macroexp-strip-symbol-positions
+  (let ((current-form (byte-run-strip-symbol-positions
                        byte-compile-current-form))
-        (bare-car-form (macroexp-strip-symbol-positions (car form)))
+        (bare-car-form (byte-run-strip-symbol-positions (car form)))
         entry)
     ;; annotate the current call
     (if (setq entry (assq bare-car-form byte-compile-call-tree))
@@ -5463,8 +5449,6 @@ already up-to-date."
 	    (if (null (batch-byte-compile-file (car command-line-args-left)))
                 (setq error t))))
       (setq command-line-args-left (cdr command-line-args-left)))
-    (setq byte-to-native-top-level-forms
-          (macroexp-strip-symbol-positions byte-to-native-top-level-forms))
     (kill-emacs (if error 1 0))))
 
 (defun batch-byte-compile-file (file)