mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

SRFI-1: Rewrite drop-right!', drop-while', `reduce', etc. in Scheme.

Browse source 
This partially reverts commit e9508fbb7d
(May 3 2005).

* module/srfi/srfi-1.scm (take!, drop-right!, reduce, reduce-right,
  take-while, take-while!, drop-while, span, span!, lset-adjoin): New
  procedures.

* srfi/srfi-1.c (scm_srfi1_drop_right_x, scm_srfi1_drop_while,
  scm_srfi1_lset_adjoin, scm_srfi1_reduce, scm_srfi1_reduce_right,
  scm_srfi1_span, scm_srfi1_span_x, scm_srfi1_take_x,
  scm_srfi1_take_while, scm_srfi1_take_while_x): Rewrite as
  proxies to the corresponding Scheme procedures.

* benchmark-suite/benchmarks/srfi-1.bm ("drop-while"): New benchmark
  prefix.
This commit is contained in:
Ludovic Courtès 2010-09-02 00:03:07 +02:00
parent 5335850dbf
commit dcde43869a
3 changed files with 176 additions and 336 deletions
Download patch file Download diff file Expand all files Collapse all files

9
benchmark-suite/benchmarks/srfi-1.bm
View file

@ -36,3 +36,12 @@
(benchmark "small" 2000000 (benchmark "small" 2000000
(fold (lambda (x y) y) #f %small-list))) (fold (lambda (x y) y) #f %small-list)))
(with-benchmark-prefix "drop-while"
(benchmark "big" 30
(drop-while (lambda (n) #t) %big-list))
(benchmark "small" 2000000
(drop-while (lambda (n) #t) %small-list)))

127
module/srfi/srfi-1.scm
View file

@ -350,6 +350,30 @@ end-of-list checking in contexts where dotted lists are allowed."
(define take list-head) (define take list-head)
(define drop list-tail) (define drop list-tail)
(define (take! lst i)
"Linear-update variant of `take'."
(if (= i 0)
'()
(let ((tail (drop lst (- i 1))))
(set-cdr! tail '())
lst)))
(define (drop-right! lst i)
"Linear-update variant of `drop-right'."
(let ((tail (drop lst i)))
(if (null? tail)
'()
(let loop ((prev lst)
(tail (cdr tail)))
(if (null? tail)
(if (pair? prev)
(begin
(set-cdr! prev '())
lst)
lst)
(loop (cdr prev)
(cdr tail)))))))
(define (last pair) (define (last pair)
"Return the last element of the non-empty, finite list PAIR." "Return the last element of the non-empty, finite list PAIR."
(car (last-pair pair))) (car (last-pair pair)))
@ -441,6 +465,24 @@ that result. See the manual for details."
lis lis
(uf (g seed) (cons (f seed) lis))))) (uf (g seed) (cons (f seed) lis)))))
(define (reduce f ridentity lst)
"`reduce' is a variant of `fold', where the first call to F is on two
elements from LST, rather than one element and a given initial value.
If LST is empty, RIDENTITY is returned. If LST has just one element
then that's the return value."
(if (null? lst)
ridentity
(fold f (car lst) (cdr lst))))
(define (reduce-right f ridentity lst)
"`reduce-right' is a variant of `fold-right', where the first call to
F is on two elements from LST, rather than one element and a given
initial value. If LST is empty, RIDENTITY is returned. If LST
has just one element then that's the return value."
(if (null? lst)
ridentity
(fold-right f (last lst) (drop-right lst 1))))
;; Internal helper procedure. Map `f' over the single list `ls'. ;; Internal helper procedure. Map `f' over the single list `ls'.
;; ;;
@ -470,8 +512,72 @@ that result. See the manual for details."
(apply f l) (apply f l)
(lp (map1 cdr l))))))) (lp (map1 cdr l)))))))
;;; Searching ;;; Searching
(define (take-while pred ls)
"Return a new list which is the longest initial prefix of LS whose
elements all satisfy the predicate PRED."
(cond ((null? ls) '())
((not (pred (car ls))) '())
(else
(let ((result (list (car ls))))
(let lp ((ls (cdr ls)) (p result))
(cond ((null? ls) result)
((not (pred (car ls))) result)
(else
(set-cdr! p (list (car ls)))
(lp (cdr ls) (cdr p)))))))))
(define (take-while! pred lst)
"Linear-update variant of `take-while'."
(let loop ((prev #f)
(rest lst))
(cond ((null? rest)
lst)
((pred (car rest))
(loop rest (cdr rest)))
(else
(if (pair? prev)
(begin
(set-cdr! prev '())
lst)
'())))))
(define (drop-while pred lst)
"Drop the longest initial prefix of LST whose elements all satisfy the
predicate PRED."
(let loop ((lst lst))
(cond ((null? lst)
'())
((pred (car lst))
(loop (cdr lst)))
(else lst))))
(define (span pred lst)
"Return two values, the longest initial prefix of LST whose elements
all satisfy the predicate PRED, and the remainder of LST."
(let lp ((lst lst) (rl '()))
(if (and (not (null? lst))
(pred (car lst)))
(lp (cdr lst) (cons (car lst) rl))
(values (reverse! rl) lst))))
(define (span! pred list)
"Linear-update variant of `span'."
(let loop ((prev #f)
(rest list))
(cond ((null? rest)
(values list '()))
((pred (car rest))
(loop rest (cdr rest)))
(else
(if (pair? prev)
(begin
(set-cdr! prev '())
(values list rest))
(values '() list))))))
(define (break pred clist) (define (break pred clist)
"Return two values, the longest initial prefix of LST whose elements "Return two values, the longest initial prefix of LST whose elements
all fail the predicate PRED, and the remainder of LST." all fail the predicate PRED, and the remainder of LST."
@ -587,6 +693,27 @@ CLIST1 ... CLISTN, that satisfies PRED."
(every (lambda (el) (member el f (lambda (x y) (= y x)))) (car r)) (every (lambda (el) (member el f (lambda (x y) (= y x)))) (car r))
(lp (car r) (cdr r))))))) (lp (car r) (cdr r)))))))
;; It's not quite clear if duplicates among the `rest' elements are meant to
;; be cast out. The spec says `=' is called as (= lstelem restelem),
;; suggesting perhaps not, but the reference implementation shows the "list"
;; at each stage as including those elements already added. The latter
;; corresponds to what's described for lset-union, so that's what's done.
;;
(define (lset-adjoin = list . rest)
"Add to LIST any of the elements of REST not already in the list.
These elements are `cons'ed onto the start of LIST (so the return shares
a common tail with LIST), but the order they're added is unspecified.
The given `=' procedure is used for comparing elements, called
as `(@var{=} listelem elem)', i.e., the second argument is one of the
given REST parameters."
(let lp ((l rest) (acc list))
(if (null? l)
acc
(if (member (car l) acc (lambda (x y) (= y x)))
(lp (cdr l) acc)
(lp (cdr l) (cons (car l) acc))))))
(define (lset-union = . rest) (define (lset-union = . rest)
(let ((acc '())) (let ((acc '()))
(for-each (lambda (lst) (for-each (lambda (lst)

376
srfi/srfi-1.c
View file

@ -683,52 +683,19 @@ SCM_DEFINE (scm_srfi1_drop_right, "drop-right", 2, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM
SCM_DEFINE (scm_srfi1_drop_right_x, "drop-right!", 2, 0, 0, scm_srfi1_drop_right_x (SCM lst, SCM n)
(SCM lst, SCM n),
"Return the a list containing the @var{n} last elements of\n"
"@var{lst}. @var{lst} may be modified to build the return.")
#define FUNC_NAME s_scm_srfi1_drop_right_x
{ {
SCM tail, *p; CACHE_VAR (drop_right_x, "drop-right!");
return scm_call_2 (drop_right_x, lst, n);
if (scm_is_eq (n, SCM_INUM0))
return lst;
tail = scm_list_tail (lst, n);
p = &lst;
/* p and tail work along the list, p being the cdrloc of the cell n steps
behind tail */
for ( ; scm_is_pair (tail); tail = SCM_CDR (tail))
p = SCM_CDRLOC (*p);
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P(tail), tail, SCM_ARG1, FUNC_NAME, "list");
*p = SCM_EOL;
return lst;
} }
#undef FUNC_NAME
SCM
SCM_DEFINE (scm_srfi1_drop_while, "drop-while", 2, 0, 0, scm_srfi1_drop_while (SCM pred, SCM lst)
(SCM pred, SCM lst),
"Drop the longest initial prefix of @var{lst} whose elements all\n"
"satisfy the predicate @var{pred}.")
#define FUNC_NAME s_scm_srfi1_drop_while
{ {
SCM_VALIDATE_PROC (SCM_ARG1, pred); CACHE_VAR (drop_while, "drop-while");
return scm_call_2 (drop_while, pred, lst);
for ( ; scm_is_pair (lst); lst = SCM_CDR (lst))
if (scm_is_false (scm_call_1 (pred, SCM_CAR (lst))))
goto done;
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list");
done:
return lst;
} }
#undef FUNC_NAME
SCM SCM
scm_srfi1_eighth (SCM lst) scm_srfi1_eighth (SCM lst)
@ -966,55 +933,12 @@ scm_srfi1_list_tabulate (SCM n, SCM proc)
return scm_call_2 (list_tabulate, n, proc); return scm_call_2 (list_tabulate, n, proc);
} }
SCM_DEFINE (scm_srfi1_lset_adjoin, "lset-adjoin", 2, 0, 1, SCM
(SCM equal, SCM lst, SCM rest), scm_srfi1_lset_adjoin (SCM equal, SCM lst, SCM rest)
"Add to @var{list} any of the given @var{elem}s not already in\n"
"the list. @var{elem}s are @code{cons}ed onto the start of\n"
"@var{list} (so the return shares a common tail with\n"
"@var{list}), but the order they're added is unspecified.\n"
"\n"
"The given @var{=} procedure is used for comparing elements,\n"
"called as @code{(@var{=} listelem elem)}, ie.@: the second\n"
"argument is one of the given @var{elem} parameters.\n"
"\n"
"@example\n"
"(lset-adjoin eqv? '(1 2 3) 4 1 5) @result{} (5 4 1 2 3)\n"
"@end example")
#define FUNC_NAME s_scm_srfi1_lset_adjoin
{ {
SCM l, elem; CACHE_VAR (lset_adjoin, "lset-adjoin");
return scm_apply_1 (lset_adjoin, lst, rest);
SCM_VALIDATE_PROC (SCM_ARG1, equal);
SCM_VALIDATE_REST_ARGUMENT (rest);
/* It's not clear if duplicates among the `rest' elements are meant to be
cast out. The spec says `=' is called as (= list-elem rest-elem),
suggesting perhaps not, but the reference implementation shows the
"list" at each stage as including those "rest" elements already added.
The latter corresponds to what's described for lset-union, so that's
what's done here. */
for ( ; scm_is_pair (rest); rest = SCM_CDR (rest))
{
elem = SCM_CAR (rest);
for (l = lst; scm_is_pair (l); l = SCM_CDR (l))
if (scm_is_true (scm_call_2 (equal, SCM_CAR (l), elem)))
goto next_elem; /* elem already in lst, don't add */
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P(l), lst, SCM_ARG2, FUNC_NAME, "list");
/* elem is not equal to anything already in lst, add it */
lst = scm_cons (elem, lst);
next_elem:
;
}
return lst;
} }
#undef FUNC_NAME
SCM_DEFINE (scm_srfi1_lset_difference_x, "lset-difference!", 2, 0, 1, SCM_DEFINE (scm_srfi1_lset_difference_x, "lset-difference!", 2, 0, 1,
(SCM equal, SCM lst, SCM rest), (SCM equal, SCM lst, SCM rest),
@ -1454,126 +1378,19 @@ SCM_DEFINE (scm_srfi1_partition_x, "partition!", 2, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM
SCM_DEFINE (scm_srfi1_reduce, "reduce", 3, 0, 0, scm_srfi1_reduce (SCM proc, SCM def, SCM lst)
(SCM proc, SCM def, SCM lst),
"@code{reduce} is a variant of @code{fold}, where the first call\n"
"to @var{proc} is on two elements from @var{lst}, rather than\n"
"one element and a given initial value.\n"
"\n"
"If @var{lst} is empty, @code{reduce} returns @var{def} (this is\n"
"the only use for @var{def}). If @var{lst} has just one element\n"
"then that's the return value. Otherwise @var{proc} is called\n"
"on the elements of @var{lst}.\n"
"\n"
"Each @var{proc} call is @code{(@var{proc} @var{elem}\n"
"@var{previous})}, where @var{elem} is from @var{lst} (the\n"
"second and subsequent elements of @var{lst}), and\n"
"@var{previous} is the return from the previous call to\n"
"@var{proc}. The first element of @var{lst} is the\n"
"@var{previous} for the first call to @var{proc}.\n"
"\n"
"For example, the following adds a list of numbers, the calls\n"
"made to @code{+} are shown. (Of course @code{+} accepts\n"
"multiple arguments and can add a list directly, with\n"
"@code{apply}.)\n"
"\n"
"@example\n"
"(reduce + 0 '(5 6 7)) @result{} 18\n"
"\n"
"(+ 6 5) @result{} 11\n"
"(+ 7 11) @result{} 18\n"
"@end example\n"
"\n"
"@code{reduce} can be used instead of @code{fold} where the\n"
"@var{init} value is an ``identity'', meaning a value which\n"
"under @var{proc} doesn't change the result, in this case 0 is\n"
"an identity since @code{(+ 5 0)} is just 5. @code{reduce}\n"
"avoids that unnecessary call.")
#define FUNC_NAME s_scm_srfi1_reduce
{ {
SCM ret; CACHE_VAR (reduce, "reduce");
SCM_VALIDATE_PROC (SCM_ARG1, proc); return scm_call_3 (reduce, proc, def, lst);
ret = def; /* if lst is empty */
if (scm_is_pair (lst))
{
ret = SCM_CAR (lst); /* if lst has one element */
for (lst = SCM_CDR (lst); scm_is_pair (lst); lst = SCM_CDR (lst))
ret = scm_call_2 (proc, SCM_CAR (lst), ret);
}
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG3, FUNC_NAME, "list");
return ret;
} }
#undef FUNC_NAME
SCM
SCM_DEFINE (scm_srfi1_reduce_right, "reduce-right", 3, 0, 0, scm_srfi1_reduce_right (SCM proc, SCM def, SCM lst)
(SCM proc, SCM def, SCM lst),
"@code{reduce-right} is a variant of @code{fold-right}, where\n"
"the first call to @var{proc} is on two elements from @var{lst},\n"
"rather than one element and a given initial value.\n"
"\n"
"If @var{lst} is empty, @code{reduce-right} returns @var{def}\n"
"(this is the only use for @var{def}). If @var{lst} has just\n"
"one element then that's the return value. Otherwise @var{proc}\n"
"is called on the elements of @var{lst}.\n"
"\n"
"Each @var{proc} call is @code{(@var{proc} @var{elem}\n"
"@var{previous})}, where @var{elem} is from @var{lst} (the\n"
"second last and then working back to the first element of\n"
"@var{lst}), and @var{previous} is the return from the previous\n"
"call to @var{proc}. The last element of @var{lst} is the\n"
"@var{previous} for the first call to @var{proc}.\n"
"\n"
"For example, the following adds a list of numbers, the calls\n"
"made to @code{+} are shown. (Of course @code{+} accepts\n"
"multiple arguments and can add a list directly, with\n"
"@code{apply}.)\n"
"\n"
"@example\n"
"(reduce-right + 0 '(5 6 7)) @result{} 18\n"
"\n"
"(+ 6 7) @result{} 13\n"
"(+ 5 13) @result{} 18\n"
"@end example\n"
"\n"
"@code{reduce-right} can be used instead of @code{fold-right}\n"
"where the @var{init} value is an ``identity'', meaning a value\n"
"which under @var{proc} doesn't change the result, in this case\n"
"0 is an identity since @code{(+ 7 0)} is just 5.\n"
"@code{reduce-right} avoids that unnecessary call.\n"
"\n"
"@code{reduce} should be preferred over @code{reduce-right} if\n"
"the order of processing doesn't matter, or can be arranged\n"
"either way, since @code{reduce} is a little more efficient.")
#define FUNC_NAME s_scm_srfi1_reduce_right
{ {
/* To work backwards across a list requires either repeatedly traversing CACHE_VAR (reduce_right, "reduce-right");
to get each previous element, or using some memory for a reversed or return scm_call_3 (reduce_right, proc, def, lst);
random-access form. Repeated traversal might not be too terrible, but
is of course quadratic complexity and hence to be avoided in case LST
is long. A vector is preferred over a reversed list since it's more
compact and is less work for the gc to collect. */
SCM vec, ret;
ssize_t len, i;
SCM_VALIDATE_PROC (SCM_ARG1, proc);
if (SCM_NULL_OR_NIL_P (lst))
return def;
vec = scm_vector (lst);
len = SCM_SIMPLE_VECTOR_LENGTH (vec);
ret = SCM_SIMPLE_VECTOR_REF (vec, len-1);
for (i = len-2; i >= 0; i--)
ret = scm_call_2 (proc, SCM_SIMPLE_VECTOR_REF (vec, i), ret);
return ret;
} }
#undef FUNC_NAME
SCM_DEFINE (scm_srfi1_remove, "remove", 2, 0, 0, SCM_DEFINE (scm_srfi1_remove, "remove", 2, 0, 0,
(SCM pred, SCM list), (SCM pred, SCM list),
@ -1650,67 +1467,19 @@ scm_srfi1_sixth (SCM lst)
return scm_call_1 (sixth, lst); return scm_call_1 (sixth, lst);
} }
SCM
SCM_DEFINE (scm_srfi1_span, "span", 2, 0, 0, scm_srfi1_span (SCM pred, SCM lst)
(SCM pred, SCM lst),
"Return two values, the longest initial prefix of @var{lst}\n"
"whose elements all satisfy the predicate @var{pred}, and the\n"
"remainder of @var{lst}.")
#define FUNC_NAME s_scm_srfi1_span
{ {
SCM ret, *p; CACHE_VAR (span, "span");
return scm_call_2 (span, pred, lst);
SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME);
ret = SCM_EOL;
p = &ret;
for ( ; scm_is_pair (lst); lst = SCM_CDR (lst))
{
SCM elem = SCM_CAR (lst);
if (scm_is_false (scm_call_1 (pred, elem)))
goto done;
/* want this elem, tack it onto the end of ret */
*p = scm_cons (elem, SCM_EOL);
p = SCM_CDRLOC (*p);
}
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list");
done:
return scm_values (scm_list_2 (ret, lst));
} }
#undef FUNC_NAME
SCM
SCM_DEFINE (scm_srfi1_span_x, "span!", 2, 0, 0, scm_srfi1_span_x (SCM pred, SCM lst)
(SCM pred, SCM lst),
"Return two values, the longest initial prefix of @var{lst}\n"
"whose elements all satisfy the predicate @var{pred}, and the\n"
"remainder of @var{lst}. @var{lst} may be modified to form the\n"
"return.")
#define FUNC_NAME s_scm_srfi1_span_x
{ {
SCM upto, *p; CACHE_VAR (span_x, "span!");
return scm_call_2 (span_x, pred, lst);
SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME);
p = &lst;
for (upto = lst; scm_is_pair (upto); upto = SCM_CDR (upto))
{
if (scm_is_false (scm_call_1 (pred, SCM_CAR (upto))))
goto done;
/* want this element */
p = SCM_CDRLOC (upto);
}
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (upto), lst, SCM_ARG2, FUNC_NAME, "list");
done:
*p = SCM_EOL;
return scm_values (scm_list_2 (lst, upto));
} }
#undef FUNC_NAME
SCM_DEFINE (scm_srfi1_split_at, "split-at", 2, 0, 0, SCM_DEFINE (scm_srfi1_split_at, "split-at", 2, 0, 0,
(SCM lst, SCM n), (SCM lst, SCM n),
@ -1762,33 +1531,12 @@ SCM_DEFINE (scm_srfi1_split_at_x, "split-at!", 2, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM
SCM_DEFINE (scm_srfi1_take_x, "take!", 2, 0, 0, scm_srfi1_take_x (SCM lst, SCM n)
(SCM lst, SCM n),
"Return a list containing the first @var{n} elements of\n"
"@var{lst}.")
#define FUNC_NAME s_scm_srfi1_take_x
{ {
long nn; CACHE_VAR (take_x, "take!");
SCM pos; return scm_call_2 (take_x, lst, n);
nn = scm_to_signed_integer (n, 0, LONG_MAX);
if (nn == 0)
return SCM_EOL;
pos = scm_list_tail (lst, scm_from_long (nn - 1));
/* Must have at least one cell left, mustn't have reached the end of an
n-1 element list. SCM_VALIDATE_CONS here gives the same error as
scm_list_tail does on say an n-2 element list, though perhaps a range
error would make more sense (for both). */
SCM_VALIDATE_CONS (SCM_ARG1, pos);
SCM_SETCDR (pos, SCM_EOL);
return lst;
} }
#undef FUNC_NAME
SCM_DEFINE (scm_srfi1_take_right, "take-right", 2, 0, 0, SCM_DEFINE (scm_srfi1_take_right, "take-right", 2, 0, 0,
(SCM lst, SCM n), (SCM lst, SCM n),
@ -1808,63 +1556,19 @@ SCM_DEFINE (scm_srfi1_take_right, "take-right", 2, 0, 0,
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_srfi1_take_while, "take-while", 2, 0, 0, SCM
(SCM pred, SCM lst), scm_srfi1_take_while (SCM pred, SCM lst)
"Return a new list which is the longest initial prefix of\n"
"@var{lst} whose elements all satisfy the predicate @var{pred}.")
#define FUNC_NAME s_scm_srfi1_take_while
{ {
SCM ret, *p; CACHE_VAR (take_while, "take-while");
return scm_call_2 (take_while, pred, lst);
SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME);
ret = SCM_EOL;
p = &ret;
for ( ; scm_is_pair (lst); lst = SCM_CDR (lst))
{
SCM elem = SCM_CAR (lst);
if (scm_is_false (scm_call_1 (pred, elem)))
goto done;
/* want this elem, tack it onto the end of ret */
*p = scm_cons (elem, SCM_EOL);
p = SCM_CDRLOC (*p);
}
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list");
done:
return ret;
} }
#undef FUNC_NAME
SCM
SCM_DEFINE (scm_srfi1_take_while_x, "take-while!", 2, 0, 0, scm_srfi1_take_while_x (SCM pred, SCM lst)
(SCM pred, SCM lst),
"Return the longest initial prefix of @var{lst} whose elements\n"
"all satisfy the predicate @var{pred}. @var{lst} may be\n"
"modified to form the return.")
#define FUNC_NAME s_scm_srfi1_take_while_x
{ {
SCM upto, *p; CACHE_VAR (take_while_x, "take-while!");
return scm_call_2 (take_while_x, pred, lst);
SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME);
p = &lst;
for (upto = lst; scm_is_pair (upto); upto = SCM_CDR (upto))
{
if (scm_is_false (scm_call_1 (pred, SCM_CAR (upto))))
goto done;
/* want this element */
p = SCM_CDRLOC (upto);
}
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (upto), lst, SCM_ARG2, FUNC_NAME, "list");
done:
*p = SCM_EOL;
return lst;
} }
#undef FUNC_NAME
SCM SCM
scm_srfi1_tenth (SCM lst) scm_srfi1_tenth (SCM lst)