Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Improve uses of CHECK_LIST etc.

Browse source 
* src/eval.c (FletX): Report an error for invalid constructs like
‘(let* (a . 0))’, so that ‘let*’ is more consistent with ‘let’.
(lambda_arity): Use plain CHECK_CONS.
* src/fns.c (CHECK_LIST_END): Move from here to lisp.h.
(Fcopy_alist): Remove unnecessary CHECK_LIST call, since
concat does that for us.
(Fnthcdr, Fmember, Fmemql, Fdelete, Fnreverse):
Use CHECK_LIST_END, not CHECK_LIST_CONS.  This hoists a
runtime check out of the loop.
(Fmemq): Simplify and use CHECK_LIST_END instead of CHECK_LIST.
(Fassq, Fassoc, Frassq, Frassoc):
Simplify and use CHECK_LIST_END instead of CAR.
(assq_no_quit, assoc_no_quit): Simplify and assume proper list.
(Fnconc): Use plain CHECK_CONS, and do-while instead of while loop.
* src/fontset.c (Fnew_fontset):
* src/frame.c (Fmodify_frame_parameters):
Use CHECK_LIST_END at end, rather than CHECK_LIST at start, for a
more-complete check.
* src/gfilenotify.c (Fgfile_add_watch):
Omit unnecessary CHECK_LIST, since Fmember does that for us.
* src/lisp.h (lisp_h_CHECK_LIST_CONS, CHECK_LIST_CONS):
Remove; no longer used.
(CHECK_LIST_END): New inline function.
This commit is contained in:
Paul Eggert 2017-01-22 00:18:40 -08:00
parent ade0652cc2
commit 0a49f158f1
6 changed files with 94 additions and 190 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
src/eval.c
View file

@ -856,9 +856,7 @@ usage: (let* VARLIST BODY...) */)
lexenv = Vinternal_interpreter_environment;
varlist = XCAR (args);
CHECK_LIST (varlist);
while (CONSP (varlist))
for (varlist = XCAR (args); CONSP (varlist); varlist = XCDR (varlist))
{
QUIT;
@ -894,9 +892,8 @@ usage: (let* VARLIST BODY...) */)
}
else
specbind (var, val);
varlist = XCDR (varlist);
}
CHECK_LIST_END (varlist, XCAR (args));
val = Fprogn (XCDR (args));
return unbind_to (count, val);
@ -3098,7 +3095,7 @@ lambda_arity (Lisp_Object fun)
if (EQ (XCAR (fun), Qclosure))
{
fun = XCDR (fun); /* Drop `closure'. */
CHECK_LIST_CONS (fun, fun);
CHECK_CONS (fun);
}
syms_left = XCDR (fun);
if (CONSP (syms_left))

248
src/fns.c
View file

@ -89,12 +89,6 @@ enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
/* Random data-structure functions. */
static void
CHECK_LIST_END (Lisp_Object x, Lisp_Object y)
{
CHECK_TYPE (NILP (x), Qlistp, y);
}
DEFUN ("length", Flength, Slength, 1, 1, 0,
doc: /* Return the length of vector, list or string SEQUENCE.
A byte-code function object is also allowed.
@ -1202,17 +1196,12 @@ are shared, however.
Elements of ALIST that are not conses are also shared. */)
(Lisp_Object alist)
{
register Lisp_Object tem;
CHECK_LIST (alist);
if (NILP (alist))
return alist;
alist = concat (1, &alist, Lisp_Cons, 0);
for (tem = alist; CONSP (tem); tem = XCDR (tem))
alist = concat (1, &alist, Lisp_Cons, false);
for (Lisp_Object tem = alist; !NILP (tem); tem = XCDR (tem))
{
register Lisp_Object car;
car = XCAR (tem);
Lisp_Object car = XCAR (tem);
if (CONSP (car))
XSETCAR (tem, Fcons (XCAR (car), XCDR (car)));
}
@ -1356,16 +1345,20 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
doc: /* Take cdr N times on LIST, return the result. */)
(Lisp_Object n, Lisp_Object list)
{
EMACS_INT i, num;
CHECK_NUMBER (n);
num = XINT (n);
for (i = 0; i < num && !NILP (list); i++)
EMACS_INT num = XINT (n);
Lisp_Object tail = list;
for (EMACS_INT i = 0; i < num; i++)
{
if (! CONSP (tail))
{
CHECK_LIST_END (tail, list);
return Qnil;
}
tail = XCDR (tail);
QUIT;
CHECK_LIST_CONS (list, list);
list = XCDR (list);
}
return list;
return tail;
}
DEFUN ("nth", Fnth, Snth, 2, 2, 0,
@ -1392,66 +1385,52 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0,
DEFUN ("member", Fmember, Smember, 2, 2, 0,
doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
The value is actually the tail of LIST whose car is ELT. */)
(register Lisp_Object elt, Lisp_Object list)
(Lisp_Object elt, Lisp_Object list)
{
register Lisp_Object tail;
for (tail = list; !NILP (tail); tail = XCDR (tail))
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
register Lisp_Object tem;
CHECK_LIST_CONS (tail, list);
tem = XCAR (tail);
if (! NILP (Fequal (elt, tem)))
if (! NILP (Fequal (elt, XCAR (tail))))
return tail;
QUIT;
}
CHECK_LIST_END (tail, list);
return Qnil;
}
DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'.
The value is actually the tail of LIST whose car is ELT. */)
(register Lisp_Object elt, Lisp_Object list)
(Lisp_Object elt, Lisp_Object list)
{
while (1)
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
if (!CONSP (list) || EQ (XCAR (list), elt))
break;
list = XCDR (list);
if (!CONSP (list) || EQ (XCAR (list), elt))
break;
list = XCDR (list);
if (!CONSP (list) || EQ (XCAR (list), elt))
break;
list = XCDR (list);
if (EQ (XCAR (tail), elt))
return tail;
QUIT;
}
CHECK_LIST (list);
return list;
CHECK_LIST_END (tail, list);
return Qnil;
}
DEFUN ("memql", Fmemql, Smemql, 2, 2, 0,
doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eql'.
The value is actually the tail of LIST whose car is ELT. */)
(register Lisp_Object elt, Lisp_Object list)
(Lisp_Object elt, Lisp_Object list)
{
register Lisp_Object tail;
if (!FLOATP (elt))
return Fmemq (elt, list);
for (tail = list; !NILP (tail); tail = XCDR (tail))
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
register Lisp_Object tem;
CHECK_LIST_CONS (tail, list);
tem = XCAR (tail);
Lisp_Object tem = XCAR (tail);
if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
return tail;
QUIT;
}
CHECK_LIST_END (tail, list);
return Qnil;
}
@ -1461,44 +1440,27 @@ The value is actually the first element of LIST whose car is KEY.
Elements of LIST that are not conses are ignored. */)
(Lisp_Object key, Lisp_Object list)
{
while (1)
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
if (!CONSP (list)
|| (CONSP (XCAR (list))
&& EQ (XCAR (XCAR (list)), key)))
break;
list = XCDR (list);
if (!CONSP (list)
|| (CONSP (XCAR (list))
&& EQ (XCAR (XCAR (list)), key)))
break;
list = XCDR (list);
if (!CONSP (list)
|| (CONSP (XCAR (list))
&& EQ (XCAR (XCAR (list)), key)))
break;
list = XCDR (list);
if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
return XCAR (tail);
QUIT;
}
return CAR (list);
CHECK_LIST_END (tail, list);
return Qnil;
}
/* Like Fassq but never report an error and do not allow quits.
Use only on lists known never to be circular. */
Use only on objects known to be non-circular lists. */
Lisp_Object
assq_no_quit (Lisp_Object key, Lisp_Object list)
{
while (CONSP (list)
&& (!CONSP (XCAR (list))
|| !EQ (XCAR (XCAR (list)), key)))
list = XCDR (list);
return CAR_SAFE (list);
for (; ! NILP (list); list = XCDR (list))
if (CONSP (XCAR (list)) && EQ (XCAR (XCAR (list)), key))
return XCAR (list);
return Qnil;
}
DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
@ -1506,81 +1468,49 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
The value is actually the first element of LIST whose car equals KEY. */)
(Lisp_Object key, Lisp_Object list)
{
Lisp_Object car;
while (1)
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
if (!CONSP (list)
|| (CONSP (XCAR (list))
&& (car = XCAR (XCAR (list)),
EQ (car, key) || !NILP (Fequal (car, key)))))
break;
list = XCDR (list);
if (!CONSP (list)
|| (CONSP (XCAR (list))
&& (car = XCAR (XCAR (list)),
EQ (car, key) || !NILP (Fequal (car, key)))))
break;
list = XCDR (list);
if (!CONSP (list)
|| (CONSP (XCAR (list))
&& (car = XCAR (XCAR (list)),
EQ (car, key) || !NILP (Fequal (car, key)))))
break;
list = XCDR (list);
Lisp_Object car = XCAR (tail);
if (CONSP (car)
&& (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
return car;
QUIT;
}
return CAR (list);
CHECK_LIST_END (tail, list);
return Qnil;
}
/* Like Fassoc but never report an error and do not allow quits.
Use only on lists known never to be circular. */
Use only on objects known to be non-circular lists. */
Lisp_Object
assoc_no_quit (Lisp_Object key, Lisp_Object list)
{
while (CONSP (list)
&& (!CONSP (XCAR (list))
|| (!EQ (XCAR (XCAR (list)), key)
&& NILP (Fequal (XCAR (XCAR (list)), key)))))
list = XCDR (list);
return CONSP (list) ? XCAR (list) : Qnil;
for (; ! NILP (list); list = XCDR (list))
{
Lisp_Object car = XCAR (list);
if (CONSP (car)
&& (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
return car;
}
return Qnil;
}
DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST.
The value is actually the first element of LIST whose cdr is KEY. */)
(register Lisp_Object key, Lisp_Object list)
(Lisp_Object key, Lisp_Object list)
{
while (1)
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
if (!CONSP (list)
|| (CONSP (XCAR (list))
&& EQ (XCDR (XCAR (list)), key)))
break;
list = XCDR (list);
if (!CONSP (list)
|| (CONSP (XCAR (list))
&& EQ (XCDR (XCAR (list)), key)))
break;
list = XCDR (list);
if (!CONSP (list)
|| (CONSP (XCAR (list))
&& EQ (XCDR (XCAR (list)), key)))
break;
list = XCDR (list);
if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
return XCAR (tail);
QUIT;
}
return CAR (list);
CHECK_LIST_END (tail, list);
return Qnil;
}
DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
@ -1588,35 +1518,17 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
The value is actually the first element of LIST whose cdr equals KEY. */)
(Lisp_Object key, Lisp_Object list)
{
Lisp_Object cdr;
while (1)
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
if (!CONSP (list)
|| (CONSP (XCAR (list))
&& (cdr = XCDR (XCAR (list)),
EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
break;
list = XCDR (list);
if (!CONSP (list)
|| (CONSP (XCAR (list))
&& (cdr = XCDR (XCAR (list)),
EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
break;
list = XCDR (list);
if (!CONSP (list)
|| (CONSP (XCAR (list))
&& (cdr = XCDR (XCAR (list)),
EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
break;
list = XCDR (list);
Lisp_Object car = XCAR (tail);
if (CONSP (car)
&& (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
return car;
QUIT;
}
return CAR (list);
CHECK_LIST_END (tail, list);
return Qnil;
}
DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
@ -1756,10 +1668,8 @@ changing the value of a sequence `foo'. */)
{
Lisp_Object tail, prev;
for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail))
for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail))
{
CHECK_LIST_CONS (tail, seq);
if (!NILP (Fequal (elt, XCAR (tail))))
{
if (NILP (prev))
@ -1771,6 +1681,7 @@ changing the value of a sequence `foo'. */)
prev = tail;
QUIT;
}
CHECK_LIST_END (tail, seq);
}
return seq;
@ -1790,14 +1701,14 @@ This function may destructively modify SEQ to produce the value. */)
{
Lisp_Object prev, tail, next;
for (prev = Qnil, tail = seq; !NILP (tail); tail = next)
for (prev = Qnil, tail = seq; CONSP (tail); tail = next)
{
QUIT;
CHECK_LIST_CONS (tail, tail);
next = XCDR (tail);
Fsetcdr (tail, prev);
prev = tail;
}
CHECK_LIST_END (tail, seq);
seq = prev;
}
else if (VECTORP (seq))
@ -2498,14 +2409,15 @@ usage: (nconc &rest LISTS) */)
if (argnum + 1 == nargs) break;
CHECK_LIST_CONS (tem, tem);
CHECK_CONS (tem);
while (CONSP (tem))
do
{
tail = tem;
tem = XCDR (tail);
QUIT;
}
while (CONSP (tem));
tem = args[argnum + 1];
Fsetcdr (tail, tem);

8
src/fontset.c
View file

@ -1677,11 +1677,10 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
`set-fontset-font' for the meaning. */)
(Lisp_Object name, Lisp_Object fontlist)
{
Lisp_Object fontset;
Lisp_Object fontset, tail;
int id;
CHECK_STRING (name);
CHECK_LIST (fontlist);
name = Fdowncase (name);
id = fs_query_fontset (name, 0);
@ -1714,11 +1713,11 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
Fset_char_table_range (fontset, Qt, Qnil);
}
for (; CONSP (fontlist); fontlist = XCDR (fontlist))
for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object elt, script;
elt = XCAR (fontlist);
elt = XCAR (tail);
script = Fcar (elt);
elt = Fcdr (elt);
if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
@ -1727,6 +1726,7 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
else
Fset_fontset_font (name, script, elt, Qnil, Qappend);
}
CHECK_LIST_END (tail, fontlist);
return name;
}

5
src/frame.c
View file

@ -2691,9 +2691,7 @@ list, but are otherwise ignored. */)
(Lisp_Object frame, Lisp_Object alist)
{
struct frame *f = decode_live_frame (frame);
register Lisp_Object prop, val;
CHECK_LIST (alist);
Lisp_Object prop, val;
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
@ -3142,6 +3140,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
for (size = 0, tail = alist; CONSP (tail); tail = XCDR (tail))
size++;
CHECK_LIST_END (tail, alist);
USE_SAFE_ALLOCA;
SAFE_ALLOCA_LISP (parms, 2 * size);

8
src/gfilenotify.c
View file

@ -178,20 +178,18 @@ will be reported only in case of the `moved' event. */)
if (NILP (Ffile_exists_p (file)))
report_file_error ("File does not exist", file);
CHECK_LIST (flags);
if (!FUNCTIONP (callback))
wrong_type_argument (Qinvalid_function, callback);
/* Create GFile name. */
gfile = g_file_new_for_path (SSDATA (ENCODE_FILE (file)));
/* Assemble flags. */
if (!NILP (Fmember (Qwatch_mounts, flags)))
gflags |= G_FILE_MONITOR_WATCH_MOUNTS;
if (!NILP (Fmember (Qsend_moved, flags)))
gflags |= G_FILE_MONITOR_SEND_MOVED;
/* Create GFile name. */
gfile = g_file_new_for_path (SSDATA (ENCODE_FILE (file)));
/* Enable watch. */
monitor = g_file_monitor (gfile, gflags, NULL, &gerror);
g_object_unref (gfile);

6
src/lisp.h
View file

@ -310,7 +310,6 @@ error !;
# define lisp_h_XLI(o) (o)
# define lisp_h_XIL(i) (i)
#endif
#define lisp_h_CHECK_LIST_CONS(x, y) CHECK_TYPE (CONSP (x), Qlistp, y)
#define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x)
#define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
#define lisp_h_CHECK_TYPE(ok, predicate, x) \
@ -367,7 +366,6 @@ error !;
#if DEFINE_KEY_OPS_AS_MACROS
# define XLI(o) lisp_h_XLI (o)
# define XIL(i) lisp_h_XIL (i)
# define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y)
# define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x)
# define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x)
# define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x)
@ -2751,9 +2749,9 @@ CHECK_LIST (Lisp_Object x)
}
INLINE void
(CHECK_LIST_CONS) (Lisp_Object x, Lisp_Object y)
CHECK_LIST_END (Lisp_Object x, Lisp_Object y)
{
lisp_h_CHECK_LIST_CONS (x, y);
CHECK_TYPE (NILP (x), Qlistp, y);
}
INLINE void