mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00
Code Activity

(append-reverse, append-reverse!): Rewrite in C.

Browse source
This commit is contained in:
Kevin Ryde 2006-05-28 00:09:17 +00:00
parent 86f7e7d676
commit d52f0bde95
3 changed files with 61 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

59
srfi/srfi-1.c
View file

@ -124,6 +124,65 @@ SCM_DEFINE (scm_srfi1_alist_copy, "alist-copy", 1, 0, 0,
#undef FUNC_NAME
SCM_DEFINE (scm_srfi1_append_reverse, "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 '(1 2 3) '(4 5 6)) @result{} (3 2 1 4 5 6)\n"
"@end example")
#define FUNC_NAME s_scm_srfi1_append_reverse
{
while (scm_is_pair (revhead))
{
/* copy first element of revhead onto front of tail */
tail = scm_cons (SCM_CAR (revhead), tail);
revhead = SCM_CDR (revhead);
}
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (revhead), revhead, SCM_ARG1, FUNC_NAME,
"list");
return tail;
}
#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_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_break, "break", 2, 0, 0,
(SCM pred, SCM lst),
"Return two values, the longest initial prefix of @var{lst}\n"

2
srfi/srfi-1.h
View file

@ -33,6 +33,8 @@
#endif
SCM_SRFI1_API SCM scm_srfi1_alist_copy (SCM alist);
SCM_SRFI1_API SCM scm_srfi1_append_reverse (SCM revhead, SCM tail);
SCM_SRFI1_API SCM scm_srfi1_append_reverse_x (SCM revhead, SCM tail);
SCM_SRFI1_API SCM scm_srfi1_break (SCM pred, SCM lst);
SCM_SRFI1_API SCM scm_srfi1_break_x (SCM pred, SCM lst);
SCM_SRFI1_API SCM scm_srfi1_car_plus_cdr (SCM pair);

9
srfi/srfi-1.scm
View file

@ -324,15 +324,6 @@
;;; Miscelleneous: length, append, concatenate, reverse, zip & count
(define (append-reverse rev-head tail)
(let lp ((l rev-head) (acc tail))
(if (null? l)
acc
(lp (cdr l) (cons (car l) acc)))))
(define (append-reverse! rev-head tail)
(append-reverse rev-head tail)) ; XXX:optimize
(define (zip clist1 . rest)
(let lp ((l (cons clist1 rest)) (acc '()))
(if (any null? l)