diff options
Diffstat (limited to 'lisp/emacs-lisp/bytecomp.el')
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 136 |
1 files changed, 21 insertions, 115 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7ddca19626e..41d2126dbcf 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. |