summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Kastrup <dak@gnu.org>2014-04-01 16:24:29 +0200
committerMark H Weaver <mhw@netris.org>2014-04-01 10:59:18 -0400
commit0ece4850c5423d53db3245f57681053486327aa3 (patch)
tree63ac4636d0ad20fa9bee10a382240025aceee79c
parent8d124d207738be0b43dfc235a5d72519a2ab5db9 (diff)
downloadguile-0ece4850c5423d53db3245f57681053486327aa3.tar.gz
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>
-rw-r--r--libguile/list.c41
1 files changed, 36 insertions, 5 deletions
diff --git a/libguile/list.c b/libguile/list.c
index d30f9e847..01f23c0f0 100644
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -374,18 +374,49 @@ SCM_DEFINE (scm_reverse_x, "reverse!", 1, 1, 0,
"@code{reverse!}")
#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))
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_SETCDR (lst, new_tail);
- new_tail = lst;
+ SCM_SETCDR (lst, tail);
+ tail = lst;
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