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

(split-at, split-at!): Rewrite in C.

Browse source
This commit is contained in:
Kevin Ryde 2005-03-15 21:49:25 +00:00
parent 74b2357378
commit d2f57ee014
2 changed files with 53 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

51
srfi/srfi-1.c
View file

@ -1007,6 +1007,57 @@ SCM_DEFINE (scm_srfi1_remove_x, "remove!", 2, 0, 0,
#undef FUNC_NAME
SCM_DEFINE (scm_srfi1_split_at, "split-at", 2, 0, 0,
(SCM lst, SCM n),
"Return two values (multiple values), being a list of the\n"
"elements before index @var{n} in @var{lst}, and a list of those\n"
"after.")
#define FUNC_NAME s_scm_srfi1_split_at
{
size_t nn;
/* pre is a list of elements before the i split point, loc is the CDRLOC
of the last cell, ie. where to store to append to it */
SCM pre = SCM_EOL;
SCM *loc = ⪯
for (nn = scm_to_size_t (n); nn != 0; nn--)
{
SCM_VALIDATE_CONS (SCM_ARG1, lst);
*loc = scm_cons (SCM_CAR (lst), SCM_EOL);
loc = SCM_CDRLOC (*loc);
lst = SCM_CDR(lst);
}
return scm_values (scm_list_2 (pre, lst));
}
#undef FUNC_NAME
SCM_DEFINE (scm_srfi1_split_at_x, "split-at!", 2, 0, 0,
(SCM lst, SCM n),
"Return two values (multiple values), being a list of the\n"
"elements before index @var{n} in @var{lst}, and a list of those\n"
"after. @var{lst} is modified to form those values.")
#define FUNC_NAME s_scm_srfi1_split_at
{
size_t nn;
SCM upto = lst;
SCM *loc = &lst;
for (nn = scm_to_size_t (n); nn != 0; nn--)
{
SCM_VALIDATE_CONS (SCM_ARG1, upto);
loc = SCM_CDRLOC (upto);
upto = SCM_CDR (upto);
}
*loc = SCM_EOL;
return scm_values (scm_list_2 (lst, upto));
}
#undef FUNC_NAME
SCM_DEFINE (scm_srfi1_take_right, "take-right", 2, 0, 0,
(SCM lst, SCM n),
"Return the a list containing the @var{n} last elements of\n"

2
srfi/srfi-1.h
View file

@ -50,6 +50,8 @@ SCM_SRFI1_API SCM scm_srfi1_partition (SCM pred, SCM list);
SCM_SRFI1_API SCM scm_srfi1_partition_x (SCM pred, SCM list);
SCM_SRFI1_API SCM scm_srfi1_remove (SCM pred, SCM list);
SCM_SRFI1_API SCM scm_srfi1_remove_x (SCM pred, SCM list);
SCM_SRFI1_API SCM scm_srfi1_split_at (SCM lst, SCM n);
SCM_SRFI1_API SCM scm_srfi1_split_at_x (SCM lst, SCM n);
SCM_SRFI1_API SCM scm_srfi1_take_right (SCM lst, SCM n);
SCM_SRFI1_API void scm_init_srfi_1 (void);