Make FOR_EACH_TAIL more like other FOR_EACH macros
See comments by Stefan Monnier in: http://lists.gnu.org/archive/html/emacs-devel/2017-02/msg00181.html and by Eli Zaretskii in: http://lists.gnu.org/archive/html/emacs-devel/2017-02/msg00207.html * src/fns.c (internal_equal): Do not bypass check for depth overflow when tail-recursing via a dotted list tail or an overlay plist, to avoid a rare infloop. * src/lisp.h (FOR_EACH_TAIL, FOR_EACH_TAIL_SAFE): Take TAIL as an arg, and update it at each iteration, rather than have callers access it.tail. All callers changed. (FOR_EACH_TAIL): Do not check for dotted lists, as this is now the caller’s responsibility. All callers changed. (FOR_EACH_TAIL_CONS): Remove. All callers changed. (struct for_each_tail_internal.tail): Remove; no longer needed. (FOR_EACH_TAIL_INTERNAL): Remove dotted arg, and set the tail arg each time through the loop. All callers changed.
This commit is contained in:
Paul Eggert
parent
d45dbccc5d
commit
03a012a796
3 changed files with 123 additions and 111 deletions
182
src/fns.c
182
src/fns.c
|
|
@ -111,6 +111,7 @@ To get the number of bytes, use `string-bytes'. */)
|
|||
intptr_t i = 0;
|
||||
FOR_EACH_TAIL (sequence)
|
||||
i++;
|
||||
CHECK_LIST_END (sequence, sequence);
|
||||
if (MOST_POSITIVE_FIXNUM < i)
|
||||
error ("List too long");
|
||||
val = make_number (i);
|
||||
|
|
@ -1343,9 +1344,11 @@ 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)
|
||||
{
|
||||
FOR_EACH_TAIL (list)
|
||||
if (! NILP (Fequal (elt, XCAR (li.tail))))
|
||||
return li.tail;
|
||||
Lisp_Object tail = list;
|
||||
FOR_EACH_TAIL (tail)
|
||||
if (! NILP (Fequal (elt, XCAR (tail))))
|
||||
return tail;
|
||||
CHECK_LIST_END (tail, list);
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
|
|
@ -1354,9 +1357,11 @@ 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)
|
||||
{
|
||||
FOR_EACH_TAIL (list)
|
||||
if (EQ (XCAR (li.tail), elt))
|
||||
return li.tail;
|
||||
Lisp_Object tail = list;
|
||||
FOR_EACH_TAIL (tail)
|
||||
if (EQ (XCAR (tail), elt))
|
||||
return tail;
|
||||
CHECK_LIST_END (tail, list);
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
|
|
@ -1368,12 +1373,14 @@ The value is actually the tail of LIST whose car is ELT. */)
|
|||
if (!FLOATP (elt))
|
||||
return Fmemq (elt, list);
|
||||
|
||||
FOR_EACH_TAIL (list)
|
||||
Lisp_Object tail = list;
|
||||
FOR_EACH_TAIL (tail)
|
||||
{
|
||||
Lisp_Object tem = XCAR (li.tail);
|
||||
Lisp_Object tem = XCAR (tail);
|
||||
if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
|
||||
return li.tail;
|
||||
return tail;
|
||||
}
|
||||
CHECK_LIST_END (tail, list);
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
|
|
@ -1383,9 +1390,11 @@ 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)
|
||||
{
|
||||
FOR_EACH_TAIL (list)
|
||||
if (CONSP (XCAR (li.tail)) && EQ (XCAR (XCAR (li.tail)), key))
|
||||
return XCAR (li.tail);
|
||||
Lisp_Object tail = list;
|
||||
FOR_EACH_TAIL (tail)
|
||||
if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
|
||||
return XCAR (tail);
|
||||
CHECK_LIST_END (tail, list);
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
|
|
@ -1406,13 +1415,15 @@ 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)
|
||||
{
|
||||
FOR_EACH_TAIL (list)
|
||||
Lisp_Object tail = list;
|
||||
FOR_EACH_TAIL (tail)
|
||||
{
|
||||
Lisp_Object car = XCAR (li.tail);
|
||||
Lisp_Object car = XCAR (tail);
|
||||
if (CONSP (car)
|
||||
&& (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
|
||||
return car;
|
||||
}
|
||||
CHECK_LIST_END (tail, list);
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
|
|
@ -1437,9 +1448,11 @@ 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)
|
||||
{
|
||||
FOR_EACH_TAIL (list)
|
||||
if (CONSP (XCAR (li.tail)) && EQ (XCDR (XCAR (li.tail)), key))
|
||||
return XCAR (li.tail);
|
||||
Lisp_Object tail = list;
|
||||
FOR_EACH_TAIL (tail)
|
||||
if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
|
||||
return XCAR (tail);
|
||||
CHECK_LIST_END (tail, list);
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
|
|
@ -1448,13 +1461,15 @@ 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)
|
||||
{
|
||||
FOR_EACH_TAIL (list)
|
||||
Lisp_Object tail = list;
|
||||
FOR_EACH_TAIL (tail)
|
||||
{
|
||||
Lisp_Object car = XCAR (li.tail);
|
||||
Lisp_Object car = XCAR (tail);
|
||||
if (CONSP (car)
|
||||
&& (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
|
||||
return car;
|
||||
}
|
||||
CHECK_LIST_END (tail, list);
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
|
|
@ -1470,21 +1485,22 @@ the value of a list `foo'. See also `remq', which does not modify the
|
|||
argument. */)
|
||||
(Lisp_Object elt, Lisp_Object list)
|
||||
{
|
||||
Lisp_Object prev = Qnil;
|
||||
Lisp_Object prev = Qnil, tail = list;
|
||||
|
||||
FOR_EACH_TAIL (list)
|
||||
FOR_EACH_TAIL (tail)
|
||||
{
|
||||
Lisp_Object tem = XCAR (li.tail);
|
||||
Lisp_Object tem = XCAR (tail);
|
||||
if (EQ (elt, tem))
|
||||
{
|
||||
if (NILP (prev))
|
||||
list = XCDR (li.tail);
|
||||
list = XCDR (tail);
|
||||
else
|
||||
Fsetcdr (prev, XCDR (li.tail));
|
||||
Fsetcdr (prev, XCDR (tail));
|
||||
}
|
||||
else
|
||||
prev = li.tail;
|
||||
prev = tail;
|
||||
}
|
||||
CHECK_LIST_END (tail, list);
|
||||
return list;
|
||||
}
|
||||
|
||||
|
|
@ -1592,20 +1608,21 @@ changing the value of a sequence `foo'. */)
|
|||
}
|
||||
else
|
||||
{
|
||||
Lisp_Object prev = Qnil;
|
||||
Lisp_Object prev = Qnil, tail = seq;
|
||||
|
||||
FOR_EACH_TAIL (seq)
|
||||
FOR_EACH_TAIL (tail)
|
||||
{
|
||||
if (!NILP (Fequal (elt, (XCAR (li.tail)))))
|
||||
if (!NILP (Fequal (elt, XCAR (tail))))
|
||||
{
|
||||
if (NILP (prev))
|
||||
seq = XCDR (li.tail);
|
||||
seq = XCDR (tail);
|
||||
else
|
||||
Fsetcdr (prev, XCDR (li.tail));
|
||||
Fsetcdr (prev, XCDR (tail));
|
||||
}
|
||||
else
|
||||
prev = li.tail;
|
||||
prev = tail;
|
||||
}
|
||||
CHECK_LIST_END (tail, seq);
|
||||
}
|
||||
|
||||
return seq;
|
||||
|
|
@ -1678,7 +1695,8 @@ See also the function `nreverse', which is used more often. */)
|
|||
{
|
||||
new = Qnil;
|
||||
FOR_EACH_TAIL (seq)
|
||||
new = Fcons (XCAR (li.tail), new);
|
||||
new = Fcons (XCAR (seq), new);
|
||||
CHECK_LIST_END (seq, seq);
|
||||
}
|
||||
else if (VECTORP (seq))
|
||||
{
|
||||
|
|
@ -1930,14 +1948,15 @@ 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)
|
||||
{
|
||||
FOR_EACH_TAIL_SAFE (plist)
|
||||
Lisp_Object tail = plist;
|
||||
FOR_EACH_TAIL_SAFE (tail)
|
||||
{
|
||||
if (! CONSP (XCDR (li.tail)))
|
||||
if (! CONSP (XCDR (tail)))
|
||||
break;
|
||||
if (EQ (prop, XCAR (li.tail)))
|
||||
return XCAR (XCDR (li.tail));
|
||||
li.tail = XCDR (li.tail);
|
||||
if (EQ (li.tail, li.tortoise))
|
||||
if (EQ (prop, XCAR (tail)))
|
||||
return XCAR (XCDR (tail));
|
||||
tail = XCDR (tail);
|
||||
if (EQ (tail, li.tortoise))
|
||||
break;
|
||||
}
|
||||
|
||||
|
|
@ -1963,23 +1982,24 @@ 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)
|
||||
{
|
||||
Lisp_Object prev = Qnil;
|
||||
FOR_EACH_TAIL_CONS (plist)
|
||||
Lisp_Object prev = Qnil, tail = plist;
|
||||
FOR_EACH_TAIL (tail)
|
||||
{
|
||||
if (! CONSP (XCDR (li.tail)))
|
||||
if (! CONSP (XCDR (tail)))
|
||||
break;
|
||||
|
||||
if (EQ (prop, XCAR (li.tail)))
|
||||
if (EQ (prop, XCAR (tail)))
|
||||
{
|
||||
Fsetcar (XCDR (li.tail), val);
|
||||
Fsetcar (XCDR (tail), val);
|
||||
return plist;
|
||||
}
|
||||
|
||||
prev = li.tail;
|
||||
li.tail = XCDR (li.tail);
|
||||
if (EQ (li.tail, li.tortoise))
|
||||
prev = tail;
|
||||
tail = XCDR (tail);
|
||||
if (EQ (tail, li.tortoise))
|
||||
circular_list (plist);
|
||||
}
|
||||
CHECK_LIST_END (tail, plist);
|
||||
Lisp_Object newcell
|
||||
= Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
|
||||
if (NILP (prev))
|
||||
|
|
@ -2007,16 +2027,20 @@ corresponding to the given PROP, or nil if PROP is not
|
|||
one of the properties on the list. */)
|
||||
(Lisp_Object plist, Lisp_Object prop)
|
||||
{
|
||||
FOR_EACH_TAIL_CONS (plist)
|
||||
Lisp_Object tail = plist;
|
||||
FOR_EACH_TAIL (tail)
|
||||
{
|
||||
if (! CONSP (XCDR (li.tail)))
|
||||
if (! CONSP (XCDR (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))
|
||||
if (! NILP (Fequal (prop, XCAR (tail))))
|
||||
return XCAR (XCDR (tail));
|
||||
tail = XCDR (tail);
|
||||
if (EQ (tail, li.tortoise))
|
||||
circular_list (plist);
|
||||
}
|
||||
|
||||
CHECK_LIST_END (tail, plist);
|
||||
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
|
|
@ -2030,23 +2054,24 @@ 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)
|
||||
{
|
||||
Lisp_Object prev = Qnil;
|
||||
FOR_EACH_TAIL_CONS (plist)
|
||||
Lisp_Object prev = Qnil, tail = plist;
|
||||
FOR_EACH_TAIL (tail)
|
||||
{
|
||||
if (! CONSP (XCDR (li.tail)))
|
||||
if (! CONSP (XCDR (tail)))
|
||||
break;
|
||||
|
||||
if (! NILP (Fequal (prop, XCAR (li.tail))))
|
||||
if (! NILP (Fequal (prop, XCAR (tail))))
|
||||
{
|
||||
Fsetcar (XCDR (li.tail), val);
|
||||
Fsetcar (XCDR (tail), val);
|
||||
return plist;
|
||||
}
|
||||
|
||||
prev = li.tail;
|
||||
li.tail = XCDR (li.tail);
|
||||
if (EQ (li.tail, li.tortoise))
|
||||
prev = tail;
|
||||
tail = XCDR (tail);
|
||||
if (EQ (tail, li.tortoise))
|
||||
circular_list (plist);
|
||||
}
|
||||
CHECK_LIST_END (tail, plist);
|
||||
Lisp_Object newcell = list2 (prop, val);
|
||||
if (NILP (prev))
|
||||
return newcell;
|
||||
|
|
@ -2095,6 +2120,7 @@ static bool
|
|||
internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
|
||||
Lisp_Object ht)
|
||||
{
|
||||
tail_recurse:
|
||||
if (depth > 10)
|
||||
{
|
||||
if (depth > 200)
|
||||
|
|
@ -2123,7 +2149,6 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
|
|||
}
|
||||
}
|
||||
|
||||
tail_recurse:
|
||||
if (EQ (o1, o2))
|
||||
return 1;
|
||||
if (XTYPE (o1) != XTYPE (o2))
|
||||
|
|
@ -2144,20 +2169,16 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
|
|||
|
||||
case Lisp_Cons:
|
||||
{
|
||||
Lisp_Object tail1 = o1;
|
||||
FOR_EACH_TAIL_CONS (o1)
|
||||
FOR_EACH_TAIL (o1)
|
||||
{
|
||||
if (! CONSP (o2))
|
||||
return false;
|
||||
if (! internal_equal (XCAR (li.tail), XCAR (o2), depth + 1,
|
||||
props, ht))
|
||||
if (! internal_equal (XCAR (o1), XCAR (o2), depth + 1, props, ht))
|
||||
return false;
|
||||
tail1 = XCDR (li.tail);
|
||||
o2 = XCDR (o2);
|
||||
if (EQ (tail1, o2))
|
||||
if (EQ (XCDR (o1), o2))
|
||||
return true;
|
||||
}
|
||||
o1 = tail1;
|
||||
depth++;
|
||||
goto tail_recurse;
|
||||
}
|
||||
|
|
@ -2340,8 +2361,8 @@ usage: (nconc &rest LISTS) */)
|
|||
CHECK_CONS (tem);
|
||||
|
||||
Lisp_Object tail;
|
||||
FOR_EACH_TAIL_CONS (tem)
|
||||
tail = li.tail;
|
||||
FOR_EACH_TAIL (tem)
|
||||
tail = tem;
|
||||
|
||||
tem = args[argnum + 1];
|
||||
Fsetcdr (tail, tem);
|
||||
|
|
@ -2763,19 +2784,18 @@ 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)
|
||||
{
|
||||
FOR_EACH_TAIL (plist)
|
||||
Lisp_Object tail = plist;
|
||||
FOR_EACH_TAIL (tail)
|
||||
{
|
||||
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);
|
||||
if (EQ (XCAR (tail), prop))
|
||||
return tail;
|
||||
tail = XCDR (tail);
|
||||
if (! CONSP (tail))
|
||||
break;
|
||||
if (EQ (tail, li.tortoise))
|
||||
circular_list (tail);
|
||||
}
|
||||
CHECK_LIST_END (tail, plist);
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
|
|
|
|||
48
src/lisp.h
48
src/lisp.h
|
|
@ -4580,41 +4580,33 @@ enum
|
|||
Lisp_String)) \
|
||||
: make_unibyte_string (str, len))
|
||||
|
||||
/* Loop over tails of LIST, checking for dotted lists and cycles,
|
||||
and possibly quitting after each loop iteration.
|
||||
In the loop body, ‘li.tail’ is the current cons; the name ‘li’ is
|
||||
short for “list iterator”. The expression LIST may be evaluated
|
||||
more than once, and so should not have side effects. The loop body
|
||||
/* Loop over conses of the list TAIL, signaling if a cycle is found,
|
||||
and possibly quitting after each loop iteration. In the loop body,
|
||||
set TAIL to the current cons. If the loop exits normally,
|
||||
set TAIL to the terminating non-cons, typically nil. The loop body
|
||||
should not modify the list’s top level structure other than by
|
||||
perhaps deleting the current cons. */
|
||||
|
||||
#define FOR_EACH_TAIL(list) \
|
||||
FOR_EACH_TAIL_INTERNAL (list, CHECK_LIST_END (li.tail, list), \
|
||||
circular_list (list), true)
|
||||
#define FOR_EACH_TAIL(tail) \
|
||||
FOR_EACH_TAIL_INTERNAL (tail, circular_list (tail), true)
|
||||
|
||||
/* Like FOR_EACH_TAIL (LIST), except do not check for dotted lists. */
|
||||
/* Like FOR_EACH_TAIL (LIST), except do not signal or quit.
|
||||
If the loop exits due to a cycle, TAIL’s value is undefined. */
|
||||
|
||||
#define FOR_EACH_TAIL_CONS(list) \
|
||||
FOR_EACH_TAIL_INTERNAL (list, (void) 0, circular_list (list), true)
|
||||
|
||||
/* Like FOR_EACH_TAIL (LIST), except check for neither dotted lists
|
||||
nor cycles, and do not quit. */
|
||||
|
||||
#define FOR_EACH_TAIL_SAFE(list) \
|
||||
FOR_EACH_TAIL_INTERNAL (list, (void) 0, (void) (li.tail = Qnil), false)
|
||||
#define FOR_EACH_TAIL_SAFE(tail) \
|
||||
FOR_EACH_TAIL_INTERNAL (tail, (void) ((tail) = Qnil), false)
|
||||
|
||||
/* Iterator intended for use only within FOR_EACH_TAIL_INTERNAL. */
|
||||
struct for_each_tail_internal
|
||||
{
|
||||
Lisp_Object tail, tortoise;
|
||||
Lisp_Object tortoise;
|
||||
intptr_t max, n;
|
||||
unsigned short int q;
|
||||
};
|
||||
|
||||
/* Like FOR_EACH_TAIL (LIST), except evaluate DOTTED or CYCLE,
|
||||
respectively, if a dotted list or cycle is found, and check for
|
||||
quit if CHECK_QUIT. This is an internal macro intended for use
|
||||
only by the above macros.
|
||||
/* Like FOR_EACH_TAIL (LIST), except evaluate CYCLE if a cycle is
|
||||
found, and check for quit if CHECK_QUIT. This is an internal macro
|
||||
intended for use only by the above macros.
|
||||
|
||||
Use Brent’s teleporting tortoise-hare algorithm. See:
|
||||
Brent RP. BIT. 1980;20(2):176-84. doi:10.1007/BF01933190
|
||||
|
|
@ -4626,15 +4618,15 @@ struct for_each_tail_internal
|
|||
other noninterruptible areas (e.g., garbage collection) that there
|
||||
is little point to calling maybe_quit here. */
|
||||
|
||||
#define FOR_EACH_TAIL_INTERNAL(list, dotted, cycle, check_quit) \
|
||||
for (struct for_each_tail_internal li = { list, list, 2, 0, 2 }; \
|
||||
CONSP (li.tail) || (dotted, false); \
|
||||
(li.tail = XCDR (li.tail), \
|
||||
#define FOR_EACH_TAIL_INTERNAL(tail, cycle, check_quit) \
|
||||
for (struct for_each_tail_internal li = { tail, 2, 0, 2 }; \
|
||||
CONSP (tail); \
|
||||
((tail) = XCDR (tail), \
|
||||
((--li.q != 0 \
|
||||
|| ((check_quit) ? maybe_quit () : (void) 0, 0 < --li.n) \
|
||||
|| (li.q = li.n = li.max <<= 1, li.n >>= USHRT_WIDTH, \
|
||||
li.tortoise = li.tail, false)) \
|
||||
&& EQ (li.tail, li.tortoise)) \
|
||||
li.tortoise = (tail), false)) \
|
||||
&& EQ (tail, li.tortoise)) \
|
||||
? (cycle) : (void) 0))
|
||||
|
||||
/* Do a `for' loop over alist values. */
|
||||
|
|
|
|||
|
|
@ -23040,10 +23040,10 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
|
|||
n += display_mode_element (it, depth,
|
||||
/* Pad after only the last
|
||||
list element. */
|
||||
(! CONSP (XCDR (li.tail))
|
||||
(! CONSP (XCDR (elt))
|
||||
? field_width - n
|
||||
: 0),
|
||||
precision - n, XCAR (li.tail),
|
||||
precision - n, XCAR (elt),
|
||||
props, risky);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue