mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-02 08:22:22 +00:00
Code Issues Releases Activity

Signal list cycles in ‘length’ etc.

Browse Source 
Use macros like FOR_EACH_TAIL instead of maybe_quit to
catch list cycles automatically instead of relying on the
user becoming impatient and typing C-g (Bug#25606).
* src/fns.c (Flength, Fmember, Fmemq, Fmemql, Fassq, Fassoc, Frassq)
(Frassoc, Fdelete, Freverse):
Use FOR_EACH_TAIL instead of maybe_quit.
(Fnreverse): Use simple EQ to check for circular list instead
of rarely_quit, as this suffices in this unusual case.
(Fplist_put, Flax_plist_put, Flax_plist_put):
Use FOR_EACH_TAIL_CONS instead of maybe_quit.
(internal_equal): Use FOR_EACH_TAIL_CONS to check lists, instead
of by-hand tail recursion that did not catch cycles.
* src/fns.c (Fsafe_length, Fplist_get):
* src/xdisp.c (display_mode_element):
Use FOR_EACH_TAIL_SAFE instead of by-hand Floyd’s algorithm.
* src/lisp.h (QUIT_COUNT_HEURISTIC): Remove; no longer needed.
(rarely_quit): Simply count toward USHRT_MAX + 1, since the
fancier versions are no longer needed.
(FOR_EACH_TAIL_CONS, FOR_EACH_TAIL_SAFE)
(FOR_EACH_TAIL_INTERNAL): New macros, the last with definiens
mostly taken from FOR_EACH_TAIL.
(FOR_EACH_TAIL): Rewrite in terms of FOR_EACH_TAIL_INTERNAL.
This commit is contained in:
Paul Eggert 2017-02-05 13:25:37 -08:00
parent b7fa6b1f1c
commit 14dd9101ec
4 changed files with 149 additions and 216 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
etc/NEWS
View File

@ -900,6 +900,9 @@ collection).
** 'if-let*', 'when-let*', and 'and-let*' are new in subr-x.el.
The incumbent 'if-let' and 'when-let' are now aliases.
** Low-level list functions like 'length' and 'member' now do a better
job of signaling list cycles instead of looping indefinitely.
+++
** The new functions 'make-nearby-temp-file' and 'temporary-file-directory'
can be used for creation of temporary files of remote or mounted directories.

290
src/fns.c
View File

@ -108,23 +108,11 @@ To get the number of bytes, use `string-bytes'. */)
XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK);
else if (CONSP (sequence))
{
EMACS_INT i = 0;
do
{
++i;
if ((i & (QUIT_COUNT_HEURISTIC - 1)) == 0)
{
if (MOST_POSITIVE_FIXNUM < i)
error ("List too long");
maybe_quit ();
}
sequence = XCDR (sequence);
}
while (CONSP (sequence));
CHECK_LIST_END (sequence, sequence);
intptr_t i = 0;
FOR_EACH_TAIL (sequence)
i++;
if (MOST_POSITIVE_FIXNUM < i)
error ("List too long");
val = make_number (i);
}
else if (NILP (sequence))
@ -142,38 +130,10 @@ it returns 0. If LIST is circular, it returns a finite value
which is at least the number of distinct elements. */)
(Lisp_Object list)
{
Lisp_Object tail, halftail;
double hilen = 0;
uintmax_t lolen = 1;
if (! CONSP (list))
return make_number (0);
/* halftail is used to detect circular lists. */
for (tail = halftail = list; ; )
{
tail = XCDR (tail);
if (! CONSP (tail))
break;
if (EQ (tail, halftail))
break;
lolen++;
if ((lolen & 1) == 0)
{
halftail = XCDR (halftail);
if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0)
{
maybe_quit ();
if (lolen == 0)
hilen += UINTMAX_MAX + 1.0;
}
}
}
/* If the length does not fit into a fixnum, return a float.
On all known practical machines this returns an upper bound on
the true length. */
return hilen ? make_float (hilen + lolen) : make_fixnum_or_float (lolen);
intptr_t len = 0;
FOR_EACH_TAIL_SAFE (list)
len++;
return make_fixnum_or_float (len);
}
DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
@ -1383,15 +1343,9 @@ DEFUN ("member", Fmember, Smember, 2, 2, 0,
The value is actually the tail of LIST whose car is ELT. */)
(Lisp_Object elt, Lisp_Object list)
{
unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
if (! NILP (Fequal (elt, XCAR (tail))))
return tail;
rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, list);
FOR_EACH_TAIL (list)
if (! NILP (Fequal (elt, XCAR (li.tail))))
return li.tail;
return Qnil;
}
@ -1400,15 +1354,9 @@ DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
The value is actually the tail of LIST whose car is ELT. */)
(Lisp_Object elt, Lisp_Object list)
{
unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
if (EQ (XCAR (tail), elt))
return tail;
rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, list);
FOR_EACH_TAIL (list)
if (EQ (XCAR (li.tail), elt))
return li.tail;
return Qnil;
}
@ -1420,16 +1368,12 @@ The value is actually the tail of LIST whose car is ELT. */)
if (!FLOATP (elt))
return Fmemq (elt, list);
unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
FOR_EACH_TAIL (list)
{
Lisp_Object tem = XCAR (tail);
Lisp_Object tem = XCAR (li.tail);
if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
return tail;
rarely_quit (++quit_count);
return li.tail;
}
CHECK_LIST_END (tail, list);
return Qnil;
}
@ -1439,15 +1383,9 @@ 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)
{
unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
return XCAR (tail);
rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, list);
FOR_EACH_TAIL (list)
if (CONSP (XCAR (li.tail)) && EQ (XCAR (XCAR (li.tail)), key))
return XCAR (li.tail);
return Qnil;
}
@ -1468,17 +1406,13 @@ 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)
{
unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
FOR_EACH_TAIL (list)
{
Lisp_Object car = XCAR (tail);
Lisp_Object car = XCAR (li.tail);
if (CONSP (car)
&& (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
return car;
rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, list);
return Qnil;
}
@ -1503,15 +1437,9 @@ DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
The value is actually the first element of LIST whose cdr is KEY. */)
(Lisp_Object key, Lisp_Object list)
{
unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
return XCAR (tail);
rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, list);
FOR_EACH_TAIL (list)
if (CONSP (XCAR (li.tail)) && EQ (XCDR (XCAR (li.tail)), key))
return XCAR (li.tail);
return Qnil;
}
@ -1520,17 +1448,13 @@ 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)
{
unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
FOR_EACH_TAIL (list)
{
Lisp_Object car = XCAR (tail);
Lisp_Object car = XCAR (li.tail);
if (CONSP (car)
&& (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
return car;
rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, list);
return Qnil;
}
@ -1668,23 +1592,20 @@ changing the value of a sequence `foo'. */)
}
else
{
unsigned short int quit_count = 0;
Lisp_Object tail, prev;
Lisp_Object prev = Qnil;
for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail))
FOR_EACH_TAIL (seq)
{
if (!NILP (Fequal (elt, XCAR (tail))))
if (!NILP (Fequal (elt, (XCAR (li.tail)))))
{
if (NILP (prev))
seq = XCDR (tail);
seq = XCDR (li.tail);
else
Fsetcdr (prev, XCDR (tail));
Fsetcdr (prev, XCDR (li.tail));
}
else
prev = tail;
rarely_quit (++quit_count);
prev = li.tail;
}
CHECK_LIST_END (tail, seq);
}
return seq;
@ -1702,15 +1623,17 @@ This function may destructively modify SEQ to produce the value. */)
return Freverse (seq);
else if (CONSP (seq))
{
unsigned short int quit_count = 0;
Lisp_Object prev, tail, next;
for (prev = Qnil, tail = seq; CONSP (tail); tail = next)
{
next = XCDR (tail);
/* If SEQ contains a cycle, attempting to reverse it
in-place will inevitably come back to SEQ. */
if (EQ (next, seq))
circular_list (seq);
Fsetcdr (tail, prev);
prev = tail;
rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, seq);
seq = prev;
@ -1753,13 +1676,9 @@ See also the function `nreverse', which is used more often. */)
return Qnil;
else if (CONSP (seq))
{
unsigned short int quit_count = 0;
for (new = Qnil; CONSP (seq); seq = XCDR (seq))
{
new = Fcons (XCAR (seq), new);
rarely_quit (++quit_count);
}
CHECK_LIST_END (seq, seq);
new = Qnil;
FOR_EACH_TAIL (seq)
new = Fcons (XCAR (li.tail), new);
}
else if (VECTORP (seq))
{
@ -2011,18 +1930,14 @@ corresponding to the given PROP, or nil if PROP is not one of the
properties on the list. This function never signals an error. */)
(Lisp_Object plist, Lisp_Object prop)
{
Lisp_Object tail, halftail;
/* halftail is used to detect circular lists. */
tail = halftail = plist;
while (CONSP (tail) && CONSP (XCDR (tail)))
FOR_EACH_TAIL_SAFE (plist)
{
if (EQ (prop, XCAR (tail)))
return XCAR (XCDR (tail));
tail = XCDR (XCDR (tail));
halftail = XCDR (halftail);
if (EQ (tail, halftail))
if (! CONSP (XCDR (li.tail)))
break;
if (EQ (prop, XCAR (li.tail)))
return XCAR (XCDR (li.tail));
li.tail = XCDR (li.tail);
if (EQ (li.tail, li.tortoise))
break;
}
@ -2048,19 +1963,22 @@ use `(setq x (plist-put x prop val))' to be sure to use the new value.
The PLIST is modified by side effects. */)
(Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
{
unsigned short int quit_count = 0;
Lisp_Object prev = Qnil;
for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
tail = XCDR (XCDR (tail)))
FOR_EACH_TAIL_CONS (plist)
{
if (EQ (prop, XCAR (tail)))
if (! CONSP (XCDR (li.tail)))
break;
if (EQ (prop, XCAR (li.tail)))
{
Fsetcar (XCDR (tail), val);
Fsetcar (XCDR (li.tail), val);
return plist;
}
prev = tail;
rarely_quit (++quit_count);
prev = li.tail;
li.tail = XCDR (li.tail);
if (EQ (li.tail, li.tortoise))
circular_list (plist);
}
Lisp_Object newcell
= Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
@ -2089,20 +2007,16 @@ corresponding to the given PROP, or nil if PROP is not
one of the properties on the list. */)
(Lisp_Object plist, Lisp_Object prop)
{
unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = plist;
CONSP (tail) && CONSP (XCDR (tail));
tail = XCDR (XCDR (tail)))
FOR_EACH_TAIL_CONS (plist)
{
if (! NILP (Fequal (prop, XCAR (tail))))
return XCAR (XCDR (tail));
rarely_quit (++quit_count);
if (! CONSP (XCDR (li.tail)))
break;
if (! NILP (Fequal (prop, XCAR (li.tail))))
return XCAR (XCDR (li.tail));
li.tail = XCDR (li.tail);
if (EQ (li.tail, li.tortoise))
circular_list (plist);
}
CHECK_LIST_END (tail, prop);
return Qnil;
}
@ -2116,19 +2030,22 @@ use `(setq x (lax-plist-put x prop val))' to be sure to use the new value.
The PLIST is modified by side effects. */)
(Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
{
unsigned short int quit_count = 0;
Lisp_Object prev = Qnil;
for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
tail = XCDR (XCDR (tail)))
FOR_EACH_TAIL_CONS (plist)
{
if (! NILP (Fequal (prop, XCAR (tail))))
if (! CONSP (XCDR (li.tail)))
break;
if (! NILP (Fequal (prop, XCAR (li.tail))))
{
Fsetcar (XCDR (tail), val);
Fsetcar (XCDR (li.tail), val);
return plist;
}
prev = tail;
rarely_quit (++quit_count);
prev = li.tail;
li.tail = XCDR (li.tail);
if (EQ (li.tail, li.tortoise))
circular_list (plist);
}
Lisp_Object newcell = list2 (prop, val);
if (NILP (prev))
@ -2206,9 +2123,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
}
}
unsigned short int quit_count = 0;
tail_recurse:
rarely_quit (++quit_count);
if (EQ (o1, o2))
return 1;
if (XTYPE (o1) != XTYPE (o2))
@ -2228,12 +2143,24 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
}
case Lisp_Cons:
if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1, props, ht))
return 0;
o1 = XCDR (o1);
o2 = XCDR (o2);
/* FIXME: This inf-loops in a circular list! */
goto tail_recurse;
{
Lisp_Object tail1 = o1;
FOR_EACH_TAIL_CONS (o1)
{
if (! CONSP (o2))
return false;
if (! internal_equal (XCAR (li.tail), XCAR (o2), depth + 1,
props, ht))
return false;
tail1 = XCDR (li.tail);
o2 = XCDR (o2);
if (EQ (tail1, o2))
return true;
}
o1 = tail1;
depth++;
goto tail_recurse;
}
case Lisp_Misc:
if (XMISCTYPE (o1) != XMISCTYPE (o2))
@ -2247,6 +2174,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
return 0;
o1 = XOVERLAY (o1)->plist;
o2 = XOVERLAY (o2)->plist;
depth++;
goto tail_recurse;
}
if (MARKERP (o1))
@ -2397,7 +2325,6 @@ Only the last argument is not altered, and need not be a list.
usage: (nconc &rest LISTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
unsigned short int quit_count = 0;
Lisp_Object val = Qnil;
for (ptrdiff_t argnum = 0; argnum < nargs; argnum++)
@ -2413,13 +2340,8 @@ usage: (nconc &rest LISTS) */)
CHECK_CONS (tem);
Lisp_Object tail;
do
{
tail = tem;
tem = XCDR (tail);
rarely_quit (++quit_count);
}
while (CONSP (tem));
FOR_EACH_TAIL_CONS (tem)
tail = li.tail;
tem = args[argnum + 1];
Fsetcdr (tail, tem);
@ -2841,14 +2763,20 @@ property and a property with the value nil.
The value is actually the tail of PLIST whose car is PROP. */)
(Lisp_Object plist, Lisp_Object prop)
{
unsigned short int quit_count = 0;
while (CONSP (plist) && !EQ (XCAR (plist), prop))
FOR_EACH_TAIL (plist)
{
plist = XCDR (plist);
plist = CDR (plist);
rarely_quit (++quit_count);
if (EQ (XCAR (li.tail), prop))
return li.tail;
if (!CONSP (XCDR (li.tail)))
{
CHECK_LIST_END (XCDR (li.tail), plist);
return Qnil;
}
li.tail = XCDR (li.tail);
if (EQ (li.tail, li.tortoise))
circular_list (plist);
}
return plist;
return Qnil;
}
DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0,

35
src/lisp.h
View File

@ -3129,20 +3129,14 @@ extern void maybe_quit (void);
#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
/* Heuristic on how many iterations of a tight loop can be safely done
before it's time to do a quit. This must be a power of 2. It
is nice but not necessary for it to equal USHRT_MAX + 1. */
enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
/* Process a quit rarely, based on a counter COUNT, for efficiency.
"Rarely" means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1
times, whichever is smaller (somewhat arbitrary, but often faster). */
"Rarely" means once per USHRT_MAX + 1 times; this is somewhat
arbitrary, but efficient. */
INLINE void
rarely_quit (unsigned short int count)
{
if (! (count & (QUIT_COUNT_HEURISTIC - 1)))
if (! count)
maybe_quit ();
}
@ -4598,13 +4592,32 @@ enum
http://maths-people.anu.edu.au/~brent/pd/rpb051i.pdf */
#define FOR_EACH_TAIL(list) \
FOR_EACH_TAIL_INTERNAL (list, CHECK_LIST_END (li.tail, list), \
circular_list (list))
/* Like FOR_EACH_TAIL (LIST), except check only for cycles. */
#define FOR_EACH_TAIL_CONS(list) \
FOR_EACH_TAIL_INTERNAL (list, (void) 0, circular_list (list))
/* Like FOR_EACH_TAIL (LIST), except check for neither dotted lists
nor cycles. */
#define FOR_EACH_TAIL_SAFE(list) \
FOR_EACH_TAIL_INTERNAL (list, (void) 0, (void) (li.tail = Qnil))
/* Like FOR_EACH_TAIL (LIST), except evaluate DOTTED or CYCLE,
respectively, if a dotted list or cycle is found. This is an
internal macro intended for use only by the above macros. */
#define FOR_EACH_TAIL_INTERNAL(list, dotted, cycle) \
for (struct { Lisp_Object tail, tortoise; intptr_t n, max; } li \
= { list, list, 2, 2 }; \
CONSP (li.tail) || (CHECK_LIST_END (li.tail, list), false); \
CONSP (li.tail) || (dotted, false); \
(li.tail = XCDR (li.tail), \
(li.n-- == 0 \
? (void) (li.n = li.max <<= 1, li.tortoise = li.tail) \
: EQ (li.tail, li.tortoise) ? circular_list (list) : (void) 0)))
: EQ (li.tail, li.tortoise) ? (cycle) : (void) 0)))
/* Do a `for' loop over alist values. */

37
src/xdisp.c
View File

@ -23033,30 +23033,19 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
goto tail_recurse;
}
else if (STRINGP (car) || CONSP (car))
{
Lisp_Object halftail = elt;
int len = 0;
while (CONSP (elt)
&& (precision <= 0 || n < precision))
{
n += display_mode_element (it, depth,
/* Do padding only after the last
element in the list. */
(! CONSP (XCDR (elt))
? field_width - n
: 0),
precision - n, XCAR (elt),
props, risky);
elt = XCDR (elt);
len++;
if ((len & 1) == 0)
halftail = XCDR (halftail);
/* Check for cycle. */
if (EQ (halftail, elt))
break;
}
}
FOR_EACH_TAIL_SAFE (elt)
{
if (0 < precision && precision <= n)
break;
n += display_mode_element (it, depth,
/* Pad after only the last
list element. */
(! CONSP (XCDR (li.tail))
? field_width - n
: 0),
precision - n, XCAR (li.tail),
props, risky);
}
}
break;