emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

scratch/correct-warning-pos 3023e7ca3d: Remove the remnants of old posit


From: Alan Mackenzie
Subject: scratch/correct-warning-pos 3023e7ca3d: Remove the remnants of old position mechanism from scratch/correct-warning-pos
Date: Sat, 15 Jan 2022 12:37:58 -0500 (EST)

branch: scratch/correct-warning-pos
commit 3023e7ca3d911d431738551753e4cfb8e3e01ec5
Author: Alan Mackenzie <acm@muc.de>
Commit: Alan Mackenzie <acm@muc.de>

    Remove the remnants of old position mechanism from 
scratch/correct-warning-pos
    
    Also correct one or two positions in macroexp-warn-and-return invocations.
    
    * lisp/emacs-lisp/bytecomp.el (byte-compile-read-position)
    (byte-compile-last-position, byte-compile-set-symbol-position): Remove.
    (byte-compile-warning-prefix, byte-compile-function-warn)
    (byte-compile-emit-callargs-warn, byte-compile-arglist-warn)
    (byte-compile-warn-about-unresolved-functions, compile-defun)
    (byte-compile-from-buffer, byte-compile-from-buffer)
    (byte-compile-file-form-defmumble, byte-compile-check-lambda-list)
    (byte-compile-lambda, byte-compile-form, byte-compile-normal-call)
    (byte-compile-check-variable, byte-compile-push-constant)
    (byte-compile-subr-wrong-args, byte-compile-negation-optimizer)
    (byte-compile-condition-case, byte-compile-defvar, byte-compile-autoload)
    (byte-compile-lambda-form): Remove the remnants of the old warning position
    mechanism.
    (byte-compile-function-warn): Replace byte-compile-last-position by a
    symbol-with-pos-pos call.
    (compile-defun): Use local variable start-read-position to fulfil purpose of
    old byte-compile-read-position.  Push the just read FORM onto
    byte-compile-form-stack.
    
    * lisp/emacs-lisp/eieio.el (defclass): New mechanism to get the correct
    source warning position to macroexp-warn-and-return.
    
    * lisp/emacs-lisp/macroexp (macroexp--unfold-lambda): Correct the position
    argument given to macroexp-warn-and-return.
---
 lisp/emacs-lisp/bytecomp.el | 136 +++++++-------------------------------------
 lisp/emacs-lisp/eieio.el    |  17 +++---
 lisp/emacs-lisp/macroexp.el |   4 +-
 3 files changed, 34 insertions(+), 123 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 7ddca19626..41d2126dbc 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1149,11 +1149,6 @@ message buffer `default-directory'."
            (t
             (insert (format "%s\n" string)))))))
 
-(defvar byte-compile-read-position nil
-  "Character position we began the last `read' from.")
-(defvar byte-compile-last-position nil
-  "Last known character position in the input.")
-
 ;; copied from gnus-util.el
 (defsubst byte-compile-delete-first (elt list)
   (if (eq (car list) elt)
@@ -1166,43 +1161,6 @@ message buffer `default-directory'."
        (setcdr list (cddr list)))
       total)))
 
-;; The purpose of `byte-compile-set-symbol-position' is to attempt to
-;; set `byte-compile-last-position' to the "current position" in the
-;; raw source code.  This is used for warning and error messages.
-;;
-;; The function should be called for most occurrences of symbols in
-;; the forms being compiled, strictly in the order they occur in the
-;; source code.  It should never be called twice for any single
-;; occurrence, and should not be called for symbols generated by the
-;; byte compiler itself.
-;;
-;; The function works by scanning the elements in the alist
-;; `read-symbol-positions-list' for the next match for the symbol
-;; after the current value of `byte-compile-last-position', setting
-;; that variable to the match's character position, then deleting the
-;; matching element from the list.  Thus the new value for
-;; `byte-compile-last-position' is later than the old value unless,
-;; perhaps, ALLOW-PREVIOUS is non-nil.
-;;
-;; So your're probably asking yourself: Isn't this function a gross
-;; hack?  And the answer, of course, would be yes.
-(defun byte-compile-set-symbol-position (sym &optional allow-previous)
-  (when byte-compile-read-position
-    (let ((last byte-compile-last-position)
-          entry)
-      (while (progn
-              (setq entry (assq sym read-symbol-positions-list))
-              (when entry
-                (setq byte-compile-last-position
-                      (+ byte-compile-read-position (cdr entry))
-                      read-symbol-positions-list
-                      (byte-compile-delete-first
-                       entry read-symbol-positions-list)))
-              (and entry
-                    (or (and allow-previous
-                             (not (= last byte-compile-last-position)))
-                        (> last byte-compile-last-position))))))))
-
 (defvar byte-compile-last-warned-form nil)
 (defvar byte-compile-last-logged-file nil)
 (defvar byte-compile-root-dir nil
@@ -1269,34 +1227,14 @@ Return nil if such is not found."
                     (t "")))
          (offset (byte-compile--warning-source-offset))
         (pos (if (and byte-compile-current-file
-                      (integerp byte-compile-read-position)
                        (or offset (not symbols-with-pos-enabled)))
                  (with-current-buffer byte-compile-current-buffer
-                   ;; (format "%d:%d:"
-                   ;;         (save-excursion
-                   ;;           (goto-char (if symbols-with-pos-enabled
-                    ;;                          (+ byte-compile-read-position 
offset)
-                    ;;                        byte-compile-last-position)
-                    ;;                      )
-                   ;;           (1+ (count-lines (point-min) (point-at-bol))))
-                   ;;         (save-excursion
-                   ;;           (goto-char (if symbols-with-pos-enabled
-                    ;;                          (+ byte-compile-read-position 
offset)
-                    ;;                        byte-compile-last-position)
-                    ;;                      )
-                   ;;           (1+ (current-column))))
-;;;; EXPERIMENTAL STOUGH, 2018-11-22
-                    (let (old-l old-c new-l new-c)
+                    (let (new-l new-c)
                       (save-excursion
-                        (goto-char byte-compile-last-position)
-                        (setq old-l (1+ (count-lines (point-min) 
(point-at-bol)))
-                              old-c (1+ (current-column)))
                         (goto-char offset)
                         (setq new-l (1+ (count-lines (point-min) 
(point-at-bol)))
                               new-c (1+ (current-column)))
-                        (format "%d:%d:%d:%d:" old-l old-c new-l new-c)))
-;;;; END OF EXPERIMENTAL STOUGH
-                    )
+                        (format "%d:%d:" new-l new-c))))
                ""))
         (form (if (eq byte-compile-current-form :end) "end of data"
                 (or byte-compile-current-form "toplevel form"))))
@@ -1379,7 +1317,7 @@ nil.")
 STRING, FILL and LEVEL are as described in
 `byte-compile-log-warning-function', which see."
   (funcall byte-compile-log-warning-function
-           string byte-compile-last-position
+           string nil
            fill
            level))
 
@@ -1525,7 +1463,6 @@ when printing the error message."
        (t (format "%d-%d" (car signature) (cdr signature)))))
 
 (defun byte-compile-function-warn (f nargs def)
-  (byte-compile-set-symbol-position f)
   (when (and (get f 'byte-obsolete-info)
              (byte-compile-warning-enabled-p 'obsolete f))
     (byte-compile-warn-obsolete f))
@@ -1542,11 +1479,14 @@ when printing the error message."
         (if cons
             (or (memq nargs (cddr cons))
                 (push nargs (cddr cons)))
-          (push (list f byte-compile-last-position nargs)
+          (push (list f
+                      (if (symbol-with-pos-p f)
+                          (symbol-with-pos-pos f)
+                        1)              ; Should never happen.
+                      nargs)
                 byte-compile-unresolved-functions)))))
 
 (defun byte-compile-emit-callargs-warn (name actual-args min-args max-args)
-  (byte-compile-set-symbol-position name)
   (byte-compile-warn-x
    name
    "%s called with %d argument%s, but %s %s"
@@ -1672,7 +1612,6 @@ extra args."
             max (car (nreverse nums)))
       (when (or (< min (car sig))
                 (and (cdr sig) (> max (cdr sig))))
-        (byte-compile-set-symbol-position name)
         (byte-compile-warn-x
          name
          "%s being defined to take %s%s, but was previously called with %s"
@@ -1692,7 +1631,6 @@ extra args."
       (let ((sig1 (byte-compile--function-signature old))
             (sig2 (byte-compile-arglist-signature arglist)))
         (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
-          (byte-compile-set-symbol-position name)
           (byte-compile-warn-x
            name
            "%s %s used to take %s %s, now takes %s"
@@ -1785,7 +1723,7 @@ It is too wide if it has any lines longer than the 
largest of
                  (byte-compile--wide-docstring-p docs col))
         (byte-compile-warn-x
          name
-         "%s%s docstring wider than %s characters"
+         "%s%sdocstring wider than %s characters"
          kind name col))))
   form)
 
@@ -1800,11 +1738,10 @@ It is too wide if it has any lines longer than the 
largest of
       (dolist (urf byte-compile-unresolved-functions)
         (let ((f (car urf)))
           (when (not (memq f byte-compile-new-defuns))
-            (let ((byte-compile-last-position (cadr urf)))
-              (byte-compile-warn-x
-               f
-               (if (fboundp f) "the function `%s' might not be defined at 
runtime." "the function `%s' is not known to be defined.")
-               (car urf))))))))
+            (byte-compile-warn-x
+             f
+             (if (fboundp f) "the function `%s' might not be defined at 
runtime." "the function `%s' is not known to be defined.")
+               (car urf)))))))
   nil)
 
 
@@ -2266,8 +2203,7 @@ With argument ARG, insert value in current buffer after 
the form."
     (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)
+          (start-read-position (point))
           (byte-compile-last-warned-form 'nothing)
           (value (eval
                   (let ((read-with-symbol-positions (current-buffer))
@@ -2275,9 +2211,11 @@ With argument ARG, insert value in current buffer after 
the form."
                          (symbols-with-pos-enabled t))
                     (displaying-byte-compile-warnings
                      (byte-compile-sexp
-                       (eval-sexp-add-defvars
-                        (read-positioning-symbols (current-buffer))
-                        byte-compile-read-position))))
+                       (let ((form (read-positioning-symbols 
(current-buffer))))
+                         (push form byte-compile-form-stack)
+                         (eval-sexp-add-defvars
+                          form
+                          start-read-position)))))
                    lexical-binding)))
       (cond (arg
             (message "Compiling from buffer... done.")
@@ -2287,8 +2225,6 @@ With argument ARG, insert value in current buffer after 
the form."
 
 (defun byte-compile-from-buffer (inbuffer)
   (let ((byte-compile-current-buffer inbuffer)
-       (byte-compile-read-position nil)
-       (byte-compile-last-position nil)
        ;; Prevent truncation of flonums and lists as we read and print them
        (float-output-format nil)
        (case-fold-search nil)
@@ -2357,8 +2293,6 @@ With argument ARG, insert value in current buffer after 
the form."
                               (= (following-char) ?\;))
                   (forward-line 1))
                 (not (eobp)))
-         (setq byte-compile-read-position (point)
-               byte-compile-last-position byte-compile-read-position)
           (let* ((lread--unescaped-character-literals nil)
                  (form (read-positioning-symbols inbuffer))
                  (warning (byte-run--unescaped-character-literals-warning)))
@@ -2366,9 +2300,6 @@ With argument ARG, insert value in current buffer after 
the form."
            (byte-compile-toplevel-file-form form)))
        ;; Compile pending forms at end of file.
        (byte-compile-flush-pending)
-       ;; Make warnings about unresolved functions
-       ;; give the end of the file as their position.
-       (setq byte-compile-last-position (point-max))
        (byte-compile-warn-about-unresolved-functions)))
      byte-compile--outbuffer)))
 
@@ -2786,7 +2717,6 @@ not to take responsibility for the actual compilation of 
the code."
          (bare-name (bare-symbol name))
          (byte-compile-current-form name)) ; For warnings.
 
-    (byte-compile-set-symbol-position name)
     (push bare-name byte-compile-new-defuns)
     ;; When a function or macro is defined, add it to the call tree so that
     ;; we can tell when functions are not used.
@@ -2845,8 +2775,6 @@ not to take responsibility for the actual compilation of 
the code."
                (symbolp (car-safe (cdr-safe body)))
                (car-safe (cdr-safe body))
                (stringp (car-safe (cdr-safe (cdr-safe body)))))
-      ;; FIXME: We've done that already just above, so this looks wrong!
-      ;;(byte-compile-set-symbol-position name)
       (byte-compile-warn-x
        name "probable `\"' without `\\' in doc string of %s" bare-name))
 
@@ -3024,8 +2952,6 @@ If FORM is a lambda or a macro, byte-compile it as a 
function."
   (let (vars)
     (while list
       (let ((arg (car list)))
-       (when (symbolp arg)
-         (byte-compile-set-symbol-position arg))
        (cond ((or (not (symbolp arg))
                   (macroexp--const-symbol-p arg t))
               (error "Invalid lambda variable %s" arg))
@@ -3099,16 +3025,11 @@ If FORM is a lambda or a macro, byte-compile it as a 
function."
 (defun byte-compile-lambda (fun &optional add-lambda reserved-csts)
   "Byte-compile a lambda-expression and return a valid function.
 The value is usually a compiled function but may be the original
-lambda-expression.
-When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head
-of the list FUN and `byte-compile-set-symbol-position' is not called.
-Use this feature to avoid calling `byte-compile-set-symbol-position'
-for symbols generated by the byte compiler itself."
+lambda-expression."
   (if add-lambda
       (setq fun (cons 'lambda fun))
     (unless (eq 'lambda (car-safe fun))
-      (error "Not a lambda list: %S" fun))
-    (byte-compile-set-symbol-position 'lambda))
+      (error "Not a lambda list: %S" fun)))
   (byte-compile-docstring-length-warn fun)
   (byte-compile-check-lambda-list (nth 1 fun))
   (let* ((arglist (nth 1 fun))
@@ -3131,7 +3052,6 @@ for symbols generated by the byte compiler itself."
           (byte-compile--warn-lexical-dynamic var 'lambda))))
     ;; Process the interactive spec.
     (when int
-      (byte-compile-set-symbol-position 'interactive)
       ;; Skip (interactive) if it is in front (the most usual location).
       (if (eq int (car body))
          (setq body (cdr body)))
@@ -3416,13 +3336,9 @@ for symbols generated by the byte compiler itself."
     (cond
      ((not (consp form))
       (cond ((or (not (symbolp form)) (macroexp--const-symbol-p form))
-             (when (symbolp form)
-               (byte-compile-set-symbol-position form))
              (byte-compile-constant
               (if (symbolp form) (bare-symbol form) form)))
             ((and byte-compile--for-effect byte-compile-delete-errors)
-             (when (symbolp form)
-               (byte-compile-set-symbol-position form))
              (setq byte-compile--for-effect nil))
             (t
              (byte-compile-variable-ref (bare-symbol form)))))
@@ -3501,7 +3417,6 @@ for symbols generated by the byte compiler itself."
       (byte-compile-annotate-call-tree form))
   (when (and byte-compile--for-effect (eq (car form) 'mapcar)
              (byte-compile-warning-enabled-p 'mapcar 'mapcar))
-    (byte-compile-set-symbol-position 'mapcar)
     (byte-compile-warn-x
      (car form)
      "`mapcar' called for effect; use `mapc' or `dolist' instead"))
@@ -3634,8 +3549,6 @@ for symbols generated by the byte compiler itself."
 
 (defun byte-compile-check-variable (var access-type)
   "Do various error checks before a use of the variable VAR."
-  (when (symbolp var)
-    (byte-compile-set-symbol-position var))
   (cond ((or (not (symbolp var)) (macroexp--const-symbol-p var))
         (when (byte-compile-warning-enabled-p 'constants
                                                (and (symbolp var) var))
@@ -3739,7 +3652,6 @@ assignment (i.e. `setq')."
 ;; This ignores byte-compile--for-effect.
 (defun byte-compile-push-constant (const)
   (when (symbolp const)
-    (byte-compile-set-symbol-position const)
     (setq const (bare-symbol const)))
   (byte-compile-out
    'byte-constant
@@ -3895,7 +3807,6 @@ If it is nil, then the handler is 
\"byte-compile-SYMBOL.\""
 
 
 (defun byte-compile-subr-wrong-args (form n)
-  (byte-compile-set-symbol-position (car form))
   (byte-compile-warn-x (car form)
                         "`%s' called with %d arg%s, but requires %s"
                         (car form) (length (cdr form))
@@ -4831,7 +4742,6 @@ binding slots have been popped."
 ;; Even when optimization is off, /= is optimized to (not (= ...)).
 (defun byte-compile-negation-optimizer (form)
   ;; an optimizer for forms where <form1> is less efficient than (not <form2>)
-  (byte-compile-set-symbol-position (car form))
   (list 'not
     (cons (or (get (car form) 'byte-compile-negated-op)
              (error
@@ -4881,7 +4791,6 @@ binding slots have been popped."
                             (cons (byte-compile-make-tag) clause))
                           failure-handlers))
          (endtag (byte-compile-make-tag)))
-    (byte-compile-set-symbol-position 'condition-case)
     (unless (symbolp var)
       (byte-compile-warn-x
        var "`%s' is not a variable-name or nil (in condition-case)" var))
@@ -4994,7 +4903,6 @@ binding slots have been popped."
        (var (nth 1 form))
        (value (nth 2 form))
        (string (nth 3 form)))
-    (byte-compile-set-symbol-position fun)
     (when (or (> (length form) 4)
              (and (eq fun 'defconst) (null (cddr form))))
       (let ((ncall (length (cdr form))))
@@ -5027,7 +4935,6 @@ binding slots have been popped."
           `',var)))))
 
 (defun byte-compile-autoload (form)
-  (byte-compile-set-symbol-position 'autoload)
   (and (macroexp-const-p (nth 1 form))
        (macroexp-const-p (nth 5 form))
        (memq (eval (nth 5 form)) '(t macro))  ; macro-p
@@ -5042,7 +4949,6 @@ binding slots have been popped."
 ;; Lambdas in valid places are handled as special cases by various code.
 ;; The ones that remain are errors.
 (defun byte-compile-lambda-form (_form)
-  (byte-compile-set-symbol-position 'lambda)
   (error "`lambda' used as function name is invalid"))
 
 ;; Compile normally, but deal with warnings for the function being defined.
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index e6a5685b5e..820e8383d8 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -181,9 +181,11 @@ and reference them using the function `class-option'."
 
        ;; Is there an initarg, but allocation of class?
        (when (and initarg (eq alloc :class))
-         (push (format "Meaningless :initarg for class allocated slot '%S'"
-                       sname)
-               warnings))
+         (push
+           (cons sname
+                 (format "Meaningless :initarg for class allocated slot '%S'"
+                        sname))
+          warnings))
 
         (let ((init (plist-get soptions :initform)))
           (unless (or (macroexp-const-p init)
@@ -194,8 +196,9 @@ and reference them using the function `class-option'."
             ;; heuristic says and if it disagrees with normal evaluation
             ;; then tweak the initform to make it fit and emit
             ;; a warning accordingly.
-            (push (format "Ambiguous initform needs quoting: %S" init)
-                  warnings)))
+            (push
+             (cons init (format "Ambiguous initform needs quoting: %S" init))
+             warnings)))
 
        ;; Anyone can have an accessor function.  This creates a function
        ;; of the specified name, and also performs a `defsetf' if applicable
@@ -242,8 +245,8 @@ This method is obsolete."
 
     `(progn
        ,@(mapcar (lambda (w)
-                   (macroexp-warn-and-return w ; W is probably a poor choice 
for a position.
-                    w `(progn ',w) nil 'compile-only))
+                   (macroexp-warn-and-return
+                    (car w) (cdr w) `(progn ',(cdr w)) nil 'compile-only))
                  warnings)
        ;; This test must be created right away so we can have self-
        ;; referencing classes.  ei, a class whose slot can contain only
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 27a7a8f8cf..256092599b 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -162,6 +162,8 @@ Other uses risk returning non-nil value that point to the 
wrong file."
   #'macroexp-warn-and-return "28.1")
 (defun macroexp-warn-and-return (arg msg form &optional category compile-only)
   "Return code equivalent to FORM labeled with warning MSG.
+ARG is a symbol (or a form) giving the source code position of FORM
+for the message.  It should normally be a symbol with position.
 CATEGORY is the category of the warning, like the categories that
 can appear in `byte-compile-warnings'.
 COMPILE-ONLY non-nil means no warning should be emitted if the code
@@ -287,7 +289,7 @@ is executed without being compiled first."
       (setq arglist (cdr arglist)))
     (if values
         (macroexp-warn-and-return
-         name
+         arglist
          (format (if (eq values 'too-few)
                      "attempt to open-code `%s' with too few arguments"
                    "attempt to open-code `%s' with too many arguments")



reply via email to

[Prev in Thread] Current Thread [Next in Thread]