diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c index ab3492422..7a8f72e15 100644 --- a/libguile/srfi-1.c +++ b/libguile/srfi-1.c @@ -85,39 +85,6 @@ list_copy_part (SCM lst, int count, SCM *dst) } #undef FUNC_NAME - -SCM_DEFINE (scm_srfi1_append_reverse_x, "append-reverse!", 2, 0, 0, - (SCM revhead, SCM tail), - "Reverse @var{rev-head}, append @var{tail} to it, and return the\n" - "result. This is equivalent to @code{(append! (reverse!\n" - "@var{rev-head}) @var{tail})}, but its implementation is more\n" - "efficient.\n" - "\n" - "@example\n" - "(append-reverse! (list 1 2 3) '(4 5 6)) @result{} (3 2 1 4 5 6)\n" - "@end example\n" - "\n" - "@var{rev-head} may be modified in order to produce the result.") -#define FUNC_NAME s_scm_srfi1_append_reverse_x -{ - SCM newtail; - - while (scm_is_mutable_pair (revhead)) - { - /* take the first cons cell from revhead */ - newtail = revhead; - revhead = SCM_CDR (revhead); - - /* make it the new start of tail, appending the previous */ - SCM_SETCDR (newtail, tail); - tail = newtail; - } - SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (revhead), revhead, SCM_ARG1, FUNC_NAME, - "list"); - return tail; -} -#undef FUNC_NAME - SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1, (SCM pred, SCM list1, SCM rest), "Return a count of the number of times @var{pred} returns true\n" diff --git a/libguile/srfi-1.h b/libguile/srfi-1.h index 779e216ec..f23d4b035 100644 --- a/libguile/srfi-1.h +++ b/libguile/srfi-1.h @@ -24,7 +24,6 @@ #include "libguile/scm.h" -SCM_INTERNAL SCM scm_srfi1_append_reverse_x (SCM revhead, SCM tail); SCM_INTERNAL SCM scm_srfi1_count (SCM pred, SCM list1, SCM rest); SCM_INTERNAL SCM scm_srfi1_delete_duplicates (SCM lst, SCM pred); SCM_INTERNAL SCM scm_srfi1_delete_duplicates_x (SCM lst, SCM pred); diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm index 689d77812..f44b32909 100644 --- a/module/srfi/srfi-1.scm +++ b/module/srfi/srfi-1.scm @@ -481,6 +481,28 @@ result. This is equivalent to @code{(append (reverse @var{rev-head}) (wrong-type-arg 'append-reverse rev-head)) result)))) +(define (append-reverse! rev-head tail) + "Reverse @var{rev-head}, append @var{tail} to it, and return the +result. This is equivalent to @code{(append! (reverse! @var{rev-head}) +@var{tail})}, but its implementation is more efficient. + +@example +(append-reverse! (list 1 2 3) '(4 5 6)) @result{} (3 2 1 4 5 6) +@end example + +@var{rev-head} may be modified in order to produce the result." + (let lp ((rh rev-head) + (result tail)) + (if (pair? rh) + (let ((next rh) + (rh (cdr rh))) + (set-cdr! next result) + (lp rh next)) + (begin + (unless (null? rh) + (wrong-type-arg 'append-reverse! rev-head)) + result)))) + (define (zip clist1 . rest) (let lp ((l (cons clist1 rest)) (acc '())) (if (any null? l)