From 2e04ddadab266d245a3bd0f6c19223ea515bdb90 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Fri, 30 Nov 2018 14:55:48 +0000 Subject: [PATCH] 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 cad9912822d..23aa9378563 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 58c3d4b3b12..b437048e1ef 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 be727a6549a..9d84716d54c 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 95acfbba74a..6d2513e35c5 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 c216b7f6031..50de1e76acd 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); -- 2.39.5