* (patch, please test) Re: Line numbers reported by the byte compiler
[not found] ` <200112110715.fBB7FdX03941@aztec.santafe.edu>
@ 2002-05-24 19:12 ` Colin Walters
2002-05-25 21:20 ` Richard Stallman
0 siblings, 1 reply; 3+ messages in thread
From: Colin Walters @ 2002-05-24 19:12 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 3233 bytes --]
[ yes, I'm responding to old mail... ]
On Tue, 2001-12-11 at 02:15, Richard Stallman wrote:
> We could modify Fread to optionally return character positions in the
> stream of the components of the form it reads, perhaps by recursively
> substituting every form with (form . position), in the way
> Fread_from_string does.
>
> The resulting Lisp object would be rather strange and not possible to
> compile. The byte compiler expects to get Lisp expressions. It
> sometimes has to evaluate those expressions.
>
> Storing the correspondence in another place would work better.
> The compiler could access it there.
The recent discussion about symbol properties reminded me of this
thread, and gave me an idea for how to implement this (my initial idea
was storing the read position of the symbol as a property, but that
didn't end up working out, so I did it another way).
Please test this patch! It is kind of a hack (especially the
modifications to the byte-compiler), but it seems to work for most of
the cases I've tried. The problem really with this approach is that it
is very unlikely to ever be perfect. I do think though that we can get
it to work in 95% or so of the cases, and possibly more. Before I go to
that effor though, I'd like to double-check that people like this idea
and agree we should include it.
(ignore the bit about using delete* in bytecomp.el; I suppose what I'll
have to do is copy it into bytecomp.el...)
src/ChangeLog:
2002-05-23 Colin Walters <walters@gnu.org>
* lread.c (readchar_count): New variable.
(readchar): Increment it.
(unreadchar): Decrement it.
(read_multibyte): Decrement it.
(Vread_with_symbol_positions): New variable.
(Vread_symbol_positions_list): New variable.
(read_internal_start): New function, created from Fread and
Fread_from_string. Handle Vread_symbol_positions_list and
Vread_with_symbol_positions.
(readevalloop, Fread, Fread_from_string): Use it.
(read1): Use readchar_count to add symbol positions to
Vread_symbol_positions_list if Vread_with_symbol_positions is
non-nil.
(syms_of_lread): DEFVAR_LISP and initialize them.
* lread.c (read0, read1, read_list, read_vector, read_multibyte)
(substitute_object_recurse, substitute_object_in_subtree)
(substitute_in_interval): Prototype.
(read_multibyte): Return c if it's less than zero.
lisp/ChangeLog:
2002-05-24 Colin Walters <walters@gnu.org>
* emacs-lisp/bytecomp.el (byte-compile-last-line): Deleted.
(byte-compile-read-position): New variable.
(byte-compile-last-position): New variable.
(byte-compile-log-1): Use it.
(byte-compile-set-symbol-position): New function.
(byte-compile-obsolete, byte-compile-callargs-warn)
(byte-compile-arglist-warn, byte-compile-arglist-warn)
(byte-compile-print-syms, byte-compile-file-form-defmumble)
(byte-compile-check-lambda-list, byte-compile-lambda)
(byte-compile-form, byte-compile-variable-ref)
(byte-compile-subr-wrong-args, byte-compile-negation-optimizer)
(byte-compile-condition-case, byte-compile-defun)
(byte-compile-defvar, byte-compile-autoload)
(byte-compile-lambda-form): Use it.
(byte-compile-from-buffer): Set it, and bind
`read-with-symbol-positions' and `read-symbol-positions-list'.
[-- Attachment #2: bytecomp.patch --]
[-- Type: text/x-patch, Size: 28316 bytes --]
Index: src/lread.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/lread.c,v
retrieving revision 1.284
diff -u -d -u -r1.284 lread.c
--- src/lread.c 20 May 2002 08:06:11 -0000 1.284
+++ src/lread.c 24 May 2002 19:11:28 -0000
@@ -133,6 +133,13 @@
/* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
Lisp_Object Vbyte_boolean_vars;
+/* Whether or not to add a `read-positions' property to symbols
+ read. */
+Lisp_Object Vread_with_symbol_positions;
+
+/* List of (SYMBOL . POSITION) accumulated so far. */
+Lisp_Object Vread_symbol_positions_list;
+
/* List of descriptors now open for Fload. */
static Lisp_Object load_descriptor_list;
@@ -150,6 +157,9 @@
/* Number of bytes left to read in the buffer character
that `readchar' has already advanced over. */
static int readchar_backlog;
+/* Number of characters read in the current call to Fread or
+ Fread_from_string. */
+static int readchar_count;
/* This contains the last string skipped with #@. */
static char *saved_doc_string;
@@ -202,8 +212,14 @@
Write READCHAR to read a character,
UNREAD(c) to unread c to be read again.
- These macros actually read/unread a byte code, multibyte characters
- are not handled here. The caller should manage them if necessary.
+ The READCHAR and UNREAD macros are meant for reading/unreading a
+ byte code; they do not handle multibyte characters. The caller
+ should manage them if necessary.
+
+ [ Actually that seems to be a lie; READCHAR will definitely read
+ multibyte characters from buffer sources, at least. Is the
+ comment just out of date?
+ -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
*/
#define READCHAR readchar (readcharfun)
@@ -216,6 +232,8 @@
Lisp_Object tem;
register int c;
+ readchar_count++;
+
if (BUFFERP (readcharfun))
{
register struct buffer *inbuffer = XBUFFER (readcharfun);
@@ -335,6 +353,7 @@
Lisp_Object readcharfun;
int c;
{
+ readchar_count--;
if (c == -1)
/* Don't back up the pointer if we're unreading the end-of-input mark,
since readchar didn't advance it when we read it. */
@@ -389,10 +408,20 @@
call1 (readcharfun, make_number (c));
}
-static Lisp_Object read0 (), read1 (), read_list (), read_vector ();
-static int read_multibyte ();
-static Lisp_Object substitute_object_recurse ();
-static void substitute_object_in_subtree (), substitute_in_interval ();
+static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,
+ Lisp_Object));
+static Lisp_Object read0 P_ ((Lisp_Object));
+static Lisp_Object read1 P_ ((Lisp_Object, int *, int));
+
+static Lisp_Object read_list P_ ((int, Lisp_Object));
+static Lisp_Object read_vector P_ ((Lisp_Object, int));
+static int read_multibyte P_ ((int, Lisp_Object));
+
+static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object,
+ Lisp_Object));
+static void substitute_object_in_subtree P_ ((Lisp_Object,
+ Lisp_Object));
+static void substitute_in_interval P_ ((INTERVAL, Lisp_Object));
\f
/* Get a character from the tty. */
@@ -1310,7 +1339,7 @@
else if (! NILP (Vload_read_function))
val = call1 (Vload_read_function, readcharfun);
else
- val = read0 (readcharfun);
+ val = read_internal_start (readcharfun, Qnil, Qnil);
}
val = (*evalfun) (val);
@@ -1432,23 +1461,15 @@
Lisp_Object stream;
{
extern Lisp_Object Fread_minibuffer ();
-
+ Lisp_Object tem;
if (NILP (stream))
stream = Vstandard_input;
if (EQ (stream, Qt))
stream = Qread_char;
-
- readchar_backlog = -1;
- new_backquote_flag = 0;
- read_objects = Qnil;
-
if (EQ (stream, Qread_char))
return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
- if (STRINGP (stream))
- return Fcar (Fread_from_string (stream, Qnil, Qnil));
-
- return read0 (stream);
+ return read_internal_start (stream, Qnil, Qnil);
}
DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
@@ -1459,40 +1480,61 @@
(string, start, end)
Lisp_Object string, start, end;
{
- int startval, endval;
- Lisp_Object tem;
-
CHECK_STRING (string);
+ return Fcons (read_internal_start (string, start, end),
+ make_number (read_from_string_index));
+}
- if (NILP (end))
- endval = XSTRING (string)->size;
- else
- {
- CHECK_NUMBER (end);
- endval = XINT (end);
- if (endval < 0 || endval > XSTRING (string)->size)
- args_out_of_range (string, end);
- }
-
- if (NILP (start))
- startval = 0;
- else
- {
- CHECK_NUMBER (start);
- startval = XINT (start);
- if (startval < 0 || startval > endval)
- args_out_of_range (string, start);
- }
-
- read_from_string_index = startval;
- read_from_string_index_byte = string_char_to_byte (string, startval);
- read_from_string_limit = endval;
+/* Function to set up the global context we need in toplevel read
+ calls. */
+static Lisp_Object
+read_internal_start (stream, start, end)
+ Lisp_Object stream;
+ Lisp_Object start; /* Only used when stream is a string. */
+ Lisp_Object end; /* Only used when stream is a string. */
+{
+ Lisp_Object retval;
+ readchar_backlog = -1;
+ readchar_count = 0;
new_backquote_flag = 0;
read_objects = Qnil;
+ if (EQ (Vread_with_symbol_positions, Qt)
+ || EQ (Vread_with_symbol_positions, stream))
+ Vread_symbol_positions_list = Qnil;
- tem = read0 (string);
- return Fcons (tem, make_number (read_from_string_index));
+ if (STRINGP (stream))
+ {
+ int startval, endval;
+ if (NILP (end))
+ endval = XSTRING (stream)->size;
+ else
+ {
+ CHECK_NUMBER (end);
+ endval = XINT (end);
+ if (endval < 0 || endval > XSTRING (stream)->size)
+ args_out_of_range (stream, end);
+ }
+
+ if (NILP (start))
+ startval = 0;
+ else
+ {
+ CHECK_NUMBER (start);
+ startval = XINT (start);
+ if (startval < 0 || startval > endval)
+ args_out_of_range (stream, start);
+ }
+ read_from_string_index = startval;
+ read_from_string_index_byte = string_char_to_byte (stream, startval);
+ read_from_string_limit = endval;
+ }
+
+ retval = read0 (stream);
+ if (EQ (Vread_with_symbol_positions, Qt)
+ || EQ (Vread_with_symbol_positions, stream))
+ Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
+ return retval;
}
\f
/* Use this for recursive reads, in contexts where internal tokens
@@ -1532,10 +1574,16 @@
int len = 0;
int bytes;
+ if (c < 0)
+ return c;
+
str[len++] = c;
while ((c = READCHAR) >= 0xA0
&& len < MAX_MULTIBYTE_LENGTH)
- str[len++] = c;
+ {
+ str[len++] = c;
+ readchar_count--;
+ }
UNREAD (c);
if (UNIBYTE_STR_AS_MULTIBYTE_P (str, len, bytes))
return STRING_CHAR (str, len);
@@ -2314,6 +2362,11 @@
separate characters, treat them as separate characters now. */
;
+ /* We want readchar_count to be the number of characters, not
+ bytes. Hence we adjust for multibyte characters in the
+ string. ... But it doesn't seem to be necessary, because
+ READCHAR *does* read multibyte characters from buffers. */
+ /* readchar_count -= (p - read_buffer) - nchars; */
if (read_pure)
return make_pure_string (read_buffer, nchars, p - read_buffer,
is_multibyte);
@@ -2449,11 +2502,19 @@
return make_float (negative ? - value : value);
}
}
-
- if (uninterned_symbol)
- return make_symbol (read_buffer);
- else
- return intern (read_buffer);
+ {
+ Lisp_Object result = uninterned_symbol ? make_symbol (read_buffer)
+ : intern (read_buffer);
+ if (EQ (Vread_with_symbol_positions, Qt)
+ || EQ (Vread_with_symbol_positions, readcharfun))
+ Vread_symbol_positions_list =
+ /* Kind of a hack; this will probably fail if characters
+ in the symbol name were escaped. Not really a big
+ deal, though. */
+ Fcons (Fcons (result, readchar_count - Flength (Fsymbol_name (result))),
+ Vread_symbol_positions_list);
+ return result;
+ }
}
}
}
@@ -3632,6 +3693,35 @@
doc: /* Stream for read to get input from.
See documentation of `read' for possible values. */);
Vstandard_input = Qt;
+
+ DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions,
+ doc: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
+
+If this variable is a buffer, then only forms read from that buffer
+will be added to `read-symbol-positions-list'.
+If this variable is t, then all read forms will be added.
+The effect of all other values other than nil are not currently
+defined, although they may be in the future.
+
+The positions are relative to the last call to `read' or
+`read-from-string'. It is probably a bad idea to set this variable at
+the toplevel; bind it instead. */);
+ Vread_with_symbol_positions = Qnil;
+
+ DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list,
+ doc: /* An list mapping read symbols to their positions.
+This variable is modified during calls to `read' or
+`read-from-string', but only when `read-with-symbol-positions' is
+non-nil.
+
+Each element of the list looks like (SYMBOL . CHAR-POSITION), where
+CHAR-POSITION is an integer giving the offset of that occurence of the
+symbol from the position where `read' or `read-from-string' started.
+
+Note that a symbol will appear multiple times in this list, if it was
+read multiple times. The list is in the same order as the symbols
+were read in. */);
+ Vread_symbol_positions_list = Qnil;
DEFVAR_LISP ("load-path", &Vload_path,
doc: /* *List of directories to search for files to load.
Index: lisp/emacs-lisp/bytecomp.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/emacs-lisp/bytecomp.el,v
retrieving revision 2.96
diff -u -d -u -r2.96 bytecomp.el
--- lisp/emacs-lisp/bytecomp.el 24 Mar 2002 19:47:26 -0000 2.96
+++ lisp/emacs-lisp/bytecomp.el 24 May 2002 19:11:29 -0000
@@ -156,6 +156,7 @@
;; Some versions of `file' can be customized to recognize that.
(require 'backquote)
+(require 'cl)
(or (fboundp 'defsubst)
;; This really ought to be loaded already!
@@ -380,6 +381,8 @@
:type '(choice (const name) (const callers) (const calls)
(const calls+callers) (const nil)))
+(defvar byte-compile-debug nil)
+
;; (defvar byte-compile-overwrite-file t
;; "If nil, old .elc files are deleted before the new is saved, and .elc
;; files will have the same modes as the corresponding .el file. Otherwise,
@@ -794,6 +797,7 @@
(defvar byte-compile-current-form nil)
(defvar byte-compile-dest-file nil)
(defvar byte-compile-current-file nil)
+(defvar byte-compile-current-buffer nil)
(defmacro byte-compile-log (format-string &rest args)
(list 'and
@@ -813,9 +817,29 @@
(defvar byte-compile-last-warned-form nil)
(defvar byte-compile-last-logged-file nil)
-(defvar byte-compile-last-line nil
- "Last known line number in the input.")
+(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.")
+(defun byte-compile-set-symbol-position (sym &optional allow-previous)
+ (when byte-compile-read-position
+ (let ((last nil))
+ (while (progn
+ (setq last byte-compile-last-position)
+ (let* ((entry (assq sym read-symbol-positions-list))
+ (cur (cdr entry)))
+ (setq byte-compile-last-position
+ (if cur
+ (+ byte-compile-read-position cur)
+ last))
+ (setq
+ read-symbol-positions-list
+ ;; FIXME: cl.el usage. I really don't want to rewrite delete*
+ ;; though.
+ (delete* entry read-symbol-positions-list :count 1)))
+ (or (and allow-previous (not (= last byte-compile-last-position)))
+ (> last byte-compile-last-position)))))))
(defun byte-compile-display-log-head-p ()
(and (not (eq byte-compile-current-form :end))
@@ -841,8 +865,13 @@
(buffer-name byte-compile-current-file)))
(t "")))
(pos (if (and byte-compile-current-file
- (integerp byte-compile-last-line))
- (format "%d:" byte-compile-last-line)
+ (integerp byte-compile-read-position))
+ (with-current-buffer byte-compile-current-buffer
+ (format "%d:%d:" (count-lines (point-min)
+ byte-compile-last-position)
+ (save-excursion
+ (goto-char byte-compile-last-position)
+ (1+ (current-column)))))
""))
(form (or byte-compile-current-form "toplevel form")))
(cond (noninteractive
@@ -904,6 +933,7 @@
(let* ((new (get (car form) 'byte-obsolete-info))
(handler (nth 1 new))
(when (nth 2 new)))
+ (byte-compile-set-symbol-position (car form))
(if (memq 'obsolete byte-compile-warnings)
(byte-compile-warn "%s is an obsolete function%s; %s" (car form)
(if when (concat " since " when) "")
@@ -1053,16 +1083,17 @@
(not (numberp (cdr sig))))
(setcdr sig nil))
(if sig
- (if (or (< ncall (car sig))
+ (when (or (< ncall (car sig))
(and (cdr sig) (> ncall (cdr sig))))
- (byte-compile-warn
- "%s called with %d argument%s, but %s %s"
- (car form) ncall
- (if (= 1 ncall) "" "s")
- (if (< ncall (car sig))
- "requires"
- "accepts only")
- (byte-compile-arglist-signature-string sig)))
+ (byte-compile-set-symbol-position (car form))
+ (byte-compile-warn
+ "%s called with %d argument%s, but %s %s"
+ (car form) ncall
+ (if (= 1 ncall) "" "s")
+ (if (< ncall (car sig))
+ "requires"
+ "accepts only")
+ (byte-compile-arglist-signature-string sig)))
(or (and (fboundp (car form)) ; might be a subr or autoload.
(not (get (car form) 'byte-compile-noruntime)))
(eq (car form) byte-compile-current-form) ; ## this doesn't work
@@ -1090,13 +1121,15 @@
(aref old 0)
'(&rest def)))))
(sig2 (byte-compile-arglist-signature (nth 2 form))))
- (or (byte-compile-arglist-signatures-congruent-p sig1 sig2)
- (byte-compile-warn "%s %s used to take %s %s, now takes %s"
- (if (eq (car form) 'defun) "function" "macro")
- (nth 1 form)
- (byte-compile-arglist-signature-string sig1)
- (if (equal sig1 '(1 . 1)) "argument" "arguments")
- (byte-compile-arglist-signature-string sig2))))
+ (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
+ (byte-compile-set-symbol-position (nth 1 form))
+ (byte-compile-warn
+ "%s %s used to take %s %s, now takes %s"
+ (if (eq (car form) 'defun) "function" "macro")
+ (nth 1 form)
+ (byte-compile-arglist-signature-string sig1)
+ (if (equal sig1 '(1 . 1)) "argument" "arguments")
+ (byte-compile-arglist-signature-string sig2))))
;; This is the first definition. See if previous calls are compatible.
(let ((calls (assq (nth 1 form) byte-compile-unresolved-functions))
nums sig min max)
@@ -1106,20 +1139,23 @@
nums (sort (copy-sequence (cdr calls)) (function <))
min (car nums)
max (car (nreverse nums)))
- (if (or (< min (car sig))
+ (when (or (< min (car sig))
(and (cdr sig) (> max (cdr sig))))
- (byte-compile-warn
- "%s being defined to take %s%s, but was previously called with %s"
- (nth 1 form)
- (byte-compile-arglist-signature-string sig)
- (if (equal sig '(1 . 1)) " arg" " args")
- (byte-compile-arglist-signature-string (cons min max))))
+ (byte-compile-set-symbol-position (nth 1 form))
+ (byte-compile-warn
+ "%s being defined to take %s%s, but was previously called with %s"
+ (nth 1 form)
+ (byte-compile-arglist-signature-string sig)
+ (if (equal sig '(1 . 1)) " arg" " args")
+ (byte-compile-arglist-signature-string (cons min max))))
(setq byte-compile-unresolved-functions
(delq calls byte-compile-unresolved-functions)))))
)))
(defun byte-compile-print-syms (str1 strn syms)
+ (when syms
+ (byte-compile-set-symbol-position (car syms) t))
(cond ((and (cdr syms) (not noninteractive))
(let* ((str strn)
(L (length str))
@@ -1221,9 +1257,13 @@
(byte-goto-log-buffer)
(setq byte-compile-warnings-point-max (point-max))))
(unwind-protect
- (condition-case error-info
- (progn ,@body)
- (error (byte-compile-report-error error-info)))
+ (let ((--displaying-byte-compile-warnings-fn (lambda ()
+ ,@body)))
+ (if byte-compile-debug
+ (funcall --displaying-byte-compile-warnings-fn)
+ (condition-case error-info
+ (funcall --displaying-byte-compile-warnings-fn)
+ (error (byte-compile-report-error error-info)))))
(with-current-buffer "*Compile-Log*"
;; If there were compilation warnings, display them.
(unless (= byte-compile-warnings-point-max (point-max))
@@ -1403,8 +1443,8 @@
(condition-case nil (delete-file target-file) (error nil)))
;; We successfully didn't compile this file.
'no-byte-compile)
- (if byte-compile-verbose
- (message "Compiling %s..." filename))
+ (when byte-compile-verbose
+ (message "Compiling %s..." filename))
(setq byte-compiler-error-flag nil)
;; It is important that input-buffer not be current at this call,
;; so that the value of point set in input-buffer
@@ -1412,8 +1452,8 @@
(setq output-buffer (byte-compile-from-buffer input-buffer filename))
(if byte-compiler-error-flag
nil
- (if byte-compile-verbose
- (message "Compiling %s...done" filename))
+ (when byte-compile-verbose
+ (message "Compiling %s...done" filename))
(kill-buffer input-buffer)
(with-current-buffer output-buffer
(goto-char (point-max))
@@ -1482,9 +1522,15 @@
(end-of-defun)
(beginning-of-defun)
(let* ((byte-compile-current-file nil)
+ (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 (displaying-byte-compile-warnings
- (byte-compile-sexp (read (current-buffer)))))))
+ (value (eval
+ (let ((read-with-symbol-positions inbuffer)
+ (read-symbol-positions-list nil))
+ (displaying-byte-compile-warnings
+ (byte-compile-sexp (read (current-buffer))))))))
(cond (arg
(message "Compiling from buffer... done.")
(prin1 value (current-buffer))
@@ -1495,6 +1541,9 @@
(defun byte-compile-from-buffer (inbuffer &optional filename)
;; Filename is used for the loading-into-Emacs-18 error message.
(let (outbuffer
+ (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)
@@ -1502,8 +1551,8 @@
(print-level nil)
;; Prevent edebug from interfering when we compile
;; and put the output into a file.
- (edebug-all-defs nil)
- (edebug-all-forms nil)
+;; (edebug-all-defs nil)
+;; (edebug-all-forms nil)
;; Simulate entry to byte-compile-top-level
(byte-compile-constants nil)
(byte-compile-variables nil)
@@ -1511,6 +1560,10 @@
(byte-compile-depth 0)
(byte-compile-maxdepth 0)
(byte-compile-output nil)
+ ;; This allows us to get the positions of symbols read; it's
+ ;; new in Emacs 21.4.
+ (read-with-symbol-positions inbuffer)
+ (read-symbol-positions-list nil)
;; #### This is bound in b-c-close-variables.
;; (byte-compile-warnings (if (eq byte-compile-warnings t)
;; byte-compile-warning-types
@@ -1543,9 +1596,10 @@
(looking-at ";"))
(forward-line 1))
(not (eobp)))
- (let ((byte-compile-last-line (count-lines (point-min) (point))))
- (byte-compile-file-form (read inbuffer))))
-
+ (setq byte-compile-read-position (point)
+ byte-compile-last-position byte-compile-read-position)
+ (let ((form (read inbuffer)))
+ (byte-compile-file-form form)))
;; Compile pending forms at end of file.
(byte-compile-flush-pending)
(byte-compile-warn-about-unresolved-functions)
@@ -1930,7 +1984,7 @@
(that-one (assq name (symbol-value that-kind)))
(byte-compile-free-references nil)
(byte-compile-free-assignments nil))
-
+ (byte-compile-set-symbol-position name)
;; When a function or macro is defined, add it to the call tree so that
;; we can tell when functions are not used.
(if byte-compile-generate-call-tree
@@ -1953,34 +2007,35 @@
(nth 1 form)))
(setcdr that-one nil))
(this-one
- (if (and (memq 'redefine byte-compile-warnings)
+ (when (and (memq 'redefine byte-compile-warnings)
;; hack: don't warn when compiling the magic internal
;; byte-compiler macros in byte-run.el...
(not (assq (nth 1 form)
byte-compile-initial-macro-environment)))
- (byte-compile-warn "%s %s defined multiple times in this file"
- (if macrop "macro" "function")
- (nth 1 form))))
+ (byte-compile-warn "%s %s defined multiple times in this file"
+ (if macrop "macro" "function")
+ (nth 1 form))))
((and (fboundp name)
(eq (car-safe (symbol-function name))
(if macrop 'lambda 'macro)))
- (if (memq 'redefine byte-compile-warnings)
- (byte-compile-warn "%s %s being redefined as a %s"
- (if macrop "function" "macro")
- (nth 1 form)
- (if macrop "macro" "function")))
+ (when (memq 'redefine byte-compile-warnings)
+ (byte-compile-warn "%s %s being redefined as a %s"
+ (if macrop "function" "macro")
+ (nth 1 form)
+ (if macrop "macro" "function")))
;; shadow existing definition
(set this-kind
(cons (cons name nil) (symbol-value this-kind))))
)
(let ((body (nthcdr 3 form)))
- (if (and (stringp (car body))
- (symbolp (car-safe (cdr-safe body)))
- (car-safe (cdr-safe body))
- (stringp (car-safe (cdr-safe (cdr-safe body)))))
- (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
- (nth 1 form))))
-
+ (when (and (stringp (car body))
+ (symbolp (car-safe (cdr-safe body)))
+ (car-safe (cdr-safe body))
+ (stringp (car-safe (cdr-safe (cdr-safe body)))))
+ (byte-compile-set-symbol-position (nth 1 form))
+ (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
+ (nth 1 form))))
+
;; Generate code for declarations in macro definitions.
;; Remove declarations from the body of the macro definition.
(when macrop
@@ -2169,6 +2224,8 @@
(let (vars)
(while list
(let ((arg (car list)))
+ (when (symbolp arg)
+ (byte-compile-set-symbol-position arg))
(cond ((or (not (symbolp arg))
(keywordp arg)
(memq arg '(t nil)))
@@ -2194,6 +2251,7 @@
(defun byte-compile-lambda (fun)
(unless (eq 'lambda (car-safe fun))
(error "Not a lambda list: %S" fun))
+ (byte-compile-set-symbol-position 'lambda)
(byte-compile-check-lambda-list (nth 1 fun))
(let* ((arglist (nth 1 fun))
(byte-compile-bound-variables
@@ -2209,6 +2267,7 @@
(setq body (cdr body))))))
(int (assq 'interactive body)))
(cond (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)))
@@ -2419,6 +2478,8 @@
(defun byte-compile-form (form &optional for-effect)
(setq form (macroexpand form byte-compile-macro-environment))
(cond ((not (consp form))
+ (when (symbolp form)
+ (byte-compile-set-symbol-position form))
(cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))
(byte-compile-constant form))
((and for-effect byte-compile-delete-errors)
@@ -2427,8 +2488,9 @@
((symbolp (car form))
(let* ((fn (car form))
(handler (get fn 'byte-compile)))
- (if (byte-compile-const-symbol-p fn)
- (byte-compile-warn "%s called as a function" fn))
+ (byte-compile-set-symbol-position fn)
+ (when (byte-compile-const-symbol-p fn)
+ (byte-compile-warn "%s called as a function" fn))
(if (and handler
(or (not (byte-compile-version-cond
byte-compile-compatibility))
@@ -2456,6 +2518,8 @@
(byte-compile-out 'byte-call (length (cdr form))))
(defun byte-compile-variable-ref (base-op var)
+ (when (symbolp var)
+ (byte-compile-set-symbol-position var))
(if (or (not (symbolp var)) (byte-compile-const-symbol-p var))
(byte-compile-warn (if (eq base-op 'byte-varbind)
"attempt to let-bind %s %s"
@@ -2505,6 +2569,8 @@
(defun byte-compile-constant (const)
(if for-effect
(setq for-effect nil)
+ (when (symbolp const)
+ (byte-compile-set-symbol-position const))
(byte-compile-out 'byte-constant (byte-compile-get-constant const))))
;; Use this for a constant that is not the value of its containing form.
@@ -2682,6 +2748,7 @@
\f
(defun byte-compile-subr-wrong-args (form n)
+ (byte-compile-set-symbol-position (car form))
(byte-compile-warn "%s called with %d arg%s, but requires %s"
(car form) (length (cdr form))
(if (= 1 (length (cdr form))) "" "s") n)
@@ -3148,6 +3215,7 @@
;; 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
@@ -3194,9 +3262,10 @@
(byte-compile-bound-variables
(if var (cons var byte-compile-bound-variables)
byte-compile-bound-variables)))
- (or (symbolp var)
- (byte-compile-warn
- "%s is not a variable-name or nil (in condition-case)" var))
+ (byte-compile-set-symbol-position 'condition-case)
+ (unless (symbolp var)
+ (byte-compile-warn
+ "%s is not a variable-name or nil (in condition-case)" var))
(byte-compile-push-constant var)
(byte-compile-push-constant (byte-compile-top-level
(nth 2 form) for-effect))
@@ -3272,7 +3341,9 @@
(defun byte-compile-defun (form)
;; This is not used for file-level defuns with doc strings.
- (unless (symbolp (car form))
+ (if (symbolp (car form))
+ (byte-compile-set-symbol-position (car form))
+ (byte-compile-set-symbol-position 'defun)
(error "defun name must be a symbol, not %s" (car form)))
(byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
(list 'fset (list 'quote (nth 1 form))
@@ -3299,6 +3370,7 @@
(var (nth 1 form))
(value (nth 2 form))
(string (nth 3 form)))
+ (byte-compile-set-symbol-position fun)
(when (> (length form) 4)
(byte-compile-warn
"%s %s called with %d arguments, but accepts only %s"
@@ -3328,6 +3400,7 @@
`',var))))
(defun byte-compile-autoload (form)
+ (byte-compile-set-symbol-position 'autoload)
(and (byte-compile-constp (nth 1 form))
(byte-compile-constp (nth 5 form))
(eval (nth 5 form)) ; macro-p
@@ -3341,6 +3414,7 @@
;; 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.
^ permalink raw reply [flat|nested] 3+ messages in thread