[Emacs-diffs] scratch/accurate-warning-pos 2e04dda: Sundry amendments to branch scratch/accurate-warning-pos.

[Alan Mackenzie]

branch: scratch/accurate-warning-pos
commit 2e04ddadab266d245a3bd0f6c19223ea515bdb90
Author: Alan Mackenzie <address@hidden>
Commit: Alan Mackenzie <address@hidden>

    Sundry amendments to branch scratch/accurate-warning-pos.
    
    * src/lisp.h (symbols-with-pos-enabled, print-symbols-bare)
    * src/data.c (syms-of-data)
    * src/print.c (print_vectorlike, syms_of_print): Remove the leading V from
    these variable names, and make them DEFVAR_BOOLs.
    
    * src/keyboard.c (recursive_edit_1): bind symbols-with-pos-enabled and
    print-symbols-bare to nil.
    
    * lisp/emacs-lisp/bytecomp.el (compile-defun): Bind symbols-with-pos-enabled
    to t around calls to the reader.  Call read-positioning-symbols
    unconditionally (rather than read).
    (byte-compile-from-buffer): Call read-positioning-symbols unconditionally
    (rather than read).
    (byte-compile-annotate-call-tree): Make local variables containing the 
values
    of byte-compile-current-form and (car form) stripped of symbol positions, so
    that the call tree functions function without having to bind
    symbols-with-pos-enabled.
---
 lisp/emacs-lisp/bytecomp.el | 39 +++++++++++++++++++--------------------
 src/data.c                  |  4 ++--
 src/keyboard.c              |  2 ++
 src/lisp.h                  |  8 ++++----
 src/print.c                 |  7 ++++---
 5 files changed, 31 insertions(+), 29 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index cad9912..23aa937 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1258,7 +1258,7 @@ Return nil if such is not found."
        (with-current-buffer (get-buffer-create byte-compile-log-buffer)
         (goto-char (point-max))
         (let* ((inhibit-read-only t)
-               (dir (and byte-compile-current-file
+               (dir (and (stringp byte-compile-current-file)
                          (file-name-directory byte-compile-current-file)))
                (was-same (equal default-directory dir))
                pt)
@@ -2093,20 +2093,19 @@ With argument ARG, insert value in current buffer after 
the form."
   (save-excursion
     (end-of-defun)
     (beginning-of-defun)
-    (let* ((byte-compile-current-file nil)
+    (let* ((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)
           (byte-compile-last-warned-form 'nothing)
           (value (eval
                   (let ((read-with-symbol-positions (current-buffer))
-                        (read-symbol-positions-list nil))
+                        (read-symbol-positions-list nil)
+                         (symbols-with-pos-enabled t))
                     (displaying-byte-compile-warnings
                      (byte-compile-sexp
                        (eval-sexp-add-defvars
-                        (if symbols-with-pos-enabled
-                            (read-positioning-symbols (current-buffer))
-                          (read (current-buffer)))
+                        (read-positioning-symbols (current-buffer))
                         byte-compile-read-position))))
                    lexical-binding)))
       (cond (arg
@@ -2177,9 +2176,7 @@ With argument ARG, insert value in current buffer after 
the form."
          (setq byte-compile-read-position (point)
                byte-compile-last-position byte-compile-read-position)
          (let* ((lread--unescaped-character-literals nil)
-                 (form (if symbols-with-pos-enabled
-                           (read-positioning-symbols inbuffer)
-                         (read inbuffer))))
+                 (form (read-positioning-symbols inbuffer)))
             (when lread--unescaped-character-literals
               (byte-compile-warn
                "unescaped character literals %s detected!"
@@ -5024,24 +5021,26 @@ OP and OPERAND are as passed to `byte-compile-out'."
 ;;; call tree stuff
 
 (defun byte-compile-annotate-call-tree (form)
-  (let (entry)
+  (let ((current-form (byte-compile-strip-symbol-positions
+                       byte-compile-current-form))
+        (bare-car-form (byte-compile-strip-symbol-positions (car form)))
+        entry)
     ;; annotate the current call
-    (if (setq entry (assq (car form) byte-compile-call-tree))
-       (or (memq byte-compile-current-form (nth 1 entry)) ;callers
+    (if (setq entry (assq bare-car-form byte-compile-call-tree))
+       (or (memq current-form (nth 1 entry)) ;callers
            (setcar (cdr entry)
-                   (cons byte-compile-current-form (nth 1 entry))))
+                   (cons current-form (nth 1 entry))))
       (setq byte-compile-call-tree
-           (cons (list (car form) (list byte-compile-current-form) nil)
+           (cons (list bare-car-form (list current-form) nil)
                  byte-compile-call-tree)))
     ;; annotate the current function
-    (if (setq entry (assq byte-compile-current-form byte-compile-call-tree))
-       (or (memq (car form) (nth 2 entry)) ;called
+    (if (setq entry (assq current-form byte-compile-call-tree))
+       (or (memq bare-car-form (nth 2 entry)) ;called
            (setcar (cdr (cdr entry))
-                   (cons (car form) (nth 2 entry))))
+                   (cons bare-car-form (nth 2 entry))))
       (setq byte-compile-call-tree
-           (cons (list byte-compile-current-form nil (list (car form)))
-                 byte-compile-call-tree)))
-    ))
+           (cons (list current-form nil (list bare-car-form))
+                 byte-compile-call-tree)))))
 
 ;; Renamed from byte-compile-report-call-tree
 ;; to avoid interfering with completion of byte-compile-file.
diff --git a/src/data.c b/src/data.c
index 58c3d4b..b437048 100644
--- a/src/data.c
+++ b/src/data.c
@@ -4154,10 +4154,10 @@ This variable cannot be set; trying to do so will 
signal an error.  */);
   make_symbol_constant (intern_c_string ("most-negative-fixnum"));
 
   DEFSYM (Qsymbols_with_pos_enabled, "symbols-with-pos-enabled");
-  DEFVAR_BOOL ("symbols-with-pos-enabled", Vsymbols_with_pos_enabled,
+  DEFVAR_BOOL ("symbols-with-pos-enabled", symbols_with_pos_enabled,
                doc: /* Non-nil when "symbols with position" can be used as 
symbols.
 Bind this to non-nil in applications such as the byte compiler.  */);
-  Vsymbols_with_pos_enabled = false;
+  symbols_with_pos_enabled = false;
 
   DEFSYM (Qwatchers, "watchers");
   DEFSYM (Qmakunbound, "makunbound");
diff --git a/src/keyboard.c b/src/keyboard.c
index be727a6..9d84716 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -670,6 +670,8 @@ recursive_edit_1 (void)
     {
       specbind (Qstandard_output, Qt);
       specbind (Qstandard_input, Qt);
+      specbind (Qsymbols_with_pos_enabled, Qnil);
+      specbind (Qprint_symbols_bare, Qnil);
     }
 
 #ifdef HAVE_WINDOW_SYSTEM
diff --git a/src/lisp.h b/src/lisp.h
index 95acfbb..6d2513e 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -395,7 +395,7 @@ typedef EMACS_INT Lisp_Word;
 
 /* verify (NIL_IS_ZERO) */
 #define lisp_h_EQ(x, y) ((XLI ((x)) == XLI ((y)))       \
-  || (Vsymbols_with_pos_enabled    \
+  || (symbols_with_pos_enabled    \
   && (SYMBOL_WITH_POS_P ((x))                        \
       ? BARE_SYMBOL_P ((y))                               \
         ? (XSYMBOL_WITH_POS((x)))->sym == (y)          \
@@ -424,7 +424,7 @@ typedef EMACS_INT Lisp_Word;
 #define lisp_h_BARE_SYMBOL_P(x) TAGGEDP ((x), Lisp_Symbol)
 /* verify (NIL_IS_ZERO) */
 #define lisp_h_SYMBOLP(x) ((BARE_SYMBOL_P ((x)) ||               \
-                            (Vsymbols_with_pos_enabled && (SYMBOL_WITH_POS_P 
((x))))))
+                            (symbols_with_pos_enabled && (SYMBOL_WITH_POS_P 
((x))))))
 #define lisp_h_TAGGEDP(a, tag) \
    (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \
        - (unsigned) (tag)) \
@@ -463,7 +463,7 @@ typedef EMACS_INT Lisp_Word;
 /* verify (NIL_IS_ZERO) */
 # define lisp_h_XSYMBOL(a)                      \
      (eassert (SYMBOLP ((a))),                      \
-      (!Vsymbols_with_pos_enabled             \
+      (!symbols_with_pos_enabled             \
       ? (XBARE_SYMBOL ((a)))             \
        : (BARE_SYMBOL_P ((a)))           \
       ? (XBARE_SYMBOL ((a)))                                    \
@@ -661,7 +661,7 @@ extern void char_table_set (Lisp_Object, int, Lisp_Object);
 
 /* Defined in data.c.  */
 extern _Noreturn void wrong_type_argument (Lisp_Object, Lisp_Object);
-extern Lisp_Object Vsymbols_with_pos_enabled;
+extern bool symbols_with_pos_enabled;
 
 #ifdef CANNOT_DUMP
 enum { might_dump = false };
diff --git a/src/print.c b/src/print.c
index c216b7f..50de1e7 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1397,7 +1397,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object 
printcharfun, bool escapeflag,
     case PVEC_SYMBOL_WITH_POS:
       {
         struct Lisp_Symbol_With_Pos *sp = XSYMBOL_WITH_POS (obj);
-        if (Vprint_symbols_bare)
+        if (print_symbols_bare)
           print_object (sp->sym, printcharfun, escapeflag);
         else
           {
@@ -2353,11 +2353,12 @@ priorities.  Values other than nil or t are also 
treated as
 `default'.  */);
   Vprint_charset_text_property = Qdefault;
 
-  DEFVAR_BOOL ("print-symbols-bare", Vprint_symbols_bare,
+  DEFVAR_BOOL ("print-symbols-bare", print_symbols_bare,
                doc: /* A flag to control printing of symbols with position.
 If the value is nil, print these objects complete with position.
 Otherwise print just the bare symbol.  */);
-  Vprint_symbols_bare = false;
+  print_symbols_bare = false;
+  DEFSYM (Qprint_symbols_bare, "print-symbols-bare");
 
   /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
   staticpro (&Vprin1_to_string_buffer);