mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-29 22:40:34 +02:00
Make reverse! forego the cost of SCM_VALIDATE_LIST
* libguile/list.c (scm_reverse_x): Do not validate first argument to reverse! in advance. Instead undo reversal in error case. Signed-off-by: David Kastrup <dak@gnu.org> Signed-off-by: Mark H Weaver <mhw@netris.org>
This commit is contained in:
parent
8d124d2077
commit
0ece4850c5
1 changed files with 36 additions and 5 deletions
|
@ -374,18 +374,49 @@ SCM_DEFINE (scm_reverse_x, "reverse!", 1, 1, 0,
|
||||||
"@code{reverse!}")
|
"@code{reverse!}")
|
||||||
#define FUNC_NAME s_scm_reverse_x
|
#define FUNC_NAME s_scm_reverse_x
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_LIST (1, lst);
|
SCM old_lst = lst;
|
||||||
|
SCM tail = SCM_BOOL_F;
|
||||||
|
|
||||||
if (SCM_UNBNDP (new_tail))
|
if (SCM_UNBNDP (new_tail))
|
||||||
new_tail = SCM_EOL;
|
new_tail = SCM_EOL;
|
||||||
|
|
||||||
while (!SCM_NULL_OR_NIL_P (lst))
|
if (SCM_NULL_OR_NIL_P (lst))
|
||||||
|
return new_tail;
|
||||||
|
|
||||||
|
/* SCM_VALIDATE_LIST would run through the whole list to make sure it
|
||||||
|
is not eventually circular. In contrast to most list operations,
|
||||||
|
reverse! cannot get stuck in an infinite loop but arrives back at
|
||||||
|
the start when given an eventually or fully circular list. Because
|
||||||
|
of that, we can save the cost of an upfront proper list check at
|
||||||
|
the price of having to do a double reversal in the error case.
|
||||||
|
*/
|
||||||
|
|
||||||
|
while (scm_is_pair (lst))
|
||||||
{
|
{
|
||||||
SCM old_tail = SCM_CDR (lst);
|
SCM old_tail = SCM_CDR (lst);
|
||||||
SCM_SETCDR (lst, new_tail);
|
SCM_SETCDR (lst, tail);
|
||||||
new_tail = lst;
|
tail = lst;
|
||||||
lst = old_tail;
|
lst = old_tail;
|
||||||
}
|
}
|
||||||
return new_tail;
|
|
||||||
|
if (SCM_LIKELY (SCM_NULL_OR_NIL_P (lst)))
|
||||||
|
{
|
||||||
|
SCM_SETCDR (old_lst, new_tail);
|
||||||
|
return tail;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* We did not start with a proper list. Undo the reversal. */
|
||||||
|
|
||||||
|
while (scm_is_pair (tail))
|
||||||
|
{
|
||||||
|
SCM old_tail = SCM_CDR (tail);
|
||||||
|
SCM_SETCDR (tail, lst);
|
||||||
|
lst = tail;
|
||||||
|
tail = old_tail;
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM_WRONG_TYPE_ARG (1, lst);
|
||||||
|
return lst;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue