mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-24 20:30:28 +02:00
(drop-right, partition!, remove!, take-right): Rewrite in C.
remove! derived from core filter!.
This commit is contained in:
Kevin Ryde
parent
cc93eace99
commit
2b077051db
3 changed files with 134 additions and 26 deletions
130
srfi/srfi-1.c
130
srfi/srfi-1.c
|
|
@ -473,6 +473,29 @@ SCM_DEFINE (scm_srfi1_delete_duplicates_x, "delete-duplicates!", 1, 1, 0,
|
|||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_srfi1_drop_right, "drop-right", 2, 0, 0,
|
||||
(SCM lst, SCM n),
|
||||
"Return a new list containing all except the last @var{n}\n"
|
||||
"elements of @var{lst}.")
|
||||
#define FUNC_NAME s_scm_srfi1_drop_right
|
||||
{
|
||||
SCM tail = scm_list_tail (lst, n);
|
||||
SCM ret = SCM_EOL;
|
||||
SCM *rend = &ret;
|
||||
while (scm_is_pair (tail))
|
||||
{
|
||||
*rend = scm_cons (SCM_CAR (lst), SCM_EOL);
|
||||
rend = SCM_CDRLOC (*rend);
|
||||
|
||||
lst = SCM_CDR (lst);
|
||||
tail = SCM_CDR (tail);
|
||||
}
|
||||
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P(tail), tail, SCM_ARG1, FUNC_NAME, "list");
|
||||
return ret;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_srfi1_find, "find", 2, 0, 0,
|
||||
(SCM pred, SCM lst),
|
||||
"Return the first element of @var{lst} which satisfies the\n"
|
||||
|
|
@ -864,6 +887,63 @@ SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0,
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_srfi1_partition_x, "partition!", 2, 0, 0,
|
||||
(SCM pred, SCM lst),
|
||||
"Split @var{lst} into those elements which do and don't satisfy\n"
|
||||
"the predicate @var{pred}.\n"
|
||||
"\n"
|
||||
"The return is two values (@pxref{Multiple Values}), the first\n"
|
||||
"being a list of all elements from @var{lst} which satisfy\n"
|
||||
"@var{pred}, the second a list of those which do not.\n"
|
||||
"\n"
|
||||
"The elements in the result lists are in the same order as in\n"
|
||||
"@var{lst} but the order in which the calls @code{(@var{pred}\n"
|
||||
"elem)} are made on the list elements is unspecified.\n"
|
||||
"\n"
|
||||
"@var{lst} may be modified to construct the return lists.")
|
||||
#define FUNC_NAME s_scm_srfi1_partition_x
|
||||
{
|
||||
SCM tlst, flst, *tp, *fp;
|
||||
scm_t_trampoline_1 pred_tramp;
|
||||
|
||||
pred_tramp = scm_trampoline_1 (pred);
|
||||
SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME);
|
||||
|
||||
/* tlst and flst are the lists of true and false elements. tp and fp are
|
||||
where to store to append to them, initially &tlst and &flst, then
|
||||
SCM_CDRLOC of the last pair in the respective lists. */
|
||||
|
||||
tlst = SCM_EOL;
|
||||
flst = SCM_EOL;
|
||||
tp = &tlst;
|
||||
fp = &flst;
|
||||
|
||||
for ( ; scm_is_pair (lst); lst = SCM_CDR (lst))
|
||||
{
|
||||
if (scm_is_true (pred_tramp (pred, SCM_CAR (lst))))
|
||||
{
|
||||
*tp = lst;
|
||||
tp = SCM_CDRLOC (lst);
|
||||
}
|
||||
else
|
||||
{
|
||||
*fp = lst;
|
||||
fp = SCM_CDRLOC (lst);
|
||||
}
|
||||
}
|
||||
|
||||
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list");
|
||||
|
||||
/* terminate whichever didn't get the last element(s) */
|
||||
*tp = SCM_EOL;
|
||||
*fp = SCM_EOL;
|
||||
|
||||
return scm_values (scm_list_2 (tlst, flst));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_srfi1_remove, "remove", 2, 0, 0,
|
||||
(SCM pred, SCM list),
|
||||
"Return a list containing all elements from @var{lst} which do\n"
|
||||
|
|
@ -895,6 +975,56 @@ SCM_DEFINE (scm_srfi1_remove, "remove", 2, 0, 0,
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_srfi1_remove_x, "remove!", 2, 0, 0,
|
||||
(SCM pred, SCM list),
|
||||
"Return a list containing all elements from @var{list} which do\n"
|
||||
"not satisfy the predicate @var{pred}. The elements in the\n"
|
||||
"result list have the same order as in @var{list}. The order in\n"
|
||||
"which @var{pred} is applied to the list elements is not\n"
|
||||
"specified. @var{list} may be modified to build the return\n"
|
||||
"list.")
|
||||
#define FUNC_NAME s_scm_srfi1_remove_x
|
||||
{
|
||||
scm_t_trampoline_1 call = scm_trampoline_1 (pred);
|
||||
SCM walk;
|
||||
SCM *prev;
|
||||
SCM_ASSERT (call, pred, 1, FUNC_NAME);
|
||||
SCM_VALIDATE_LIST (2, list);
|
||||
|
||||
for (prev = &list, walk = list;
|
||||
scm_is_pair (walk);
|
||||
walk = SCM_CDR (walk))
|
||||
{
|
||||
if (scm_is_false (call (pred, SCM_CAR (walk))))
|
||||
prev = SCM_CDRLOC (walk);
|
||||
else
|
||||
*prev = SCM_CDR (walk);
|
||||
}
|
||||
|
||||
return list;
|
||||
}
|
||||
#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"
|
||||
"@var{lst}.")
|
||||
#define FUNC_NAME s_scm_srfi1_take_right
|
||||
{
|
||||
SCM tail = scm_list_tail (lst, n);
|
||||
while (scm_is_pair (tail))
|
||||
{
|
||||
lst = SCM_CDR (lst);
|
||||
tail = SCM_CDR (tail);
|
||||
}
|
||||
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P(tail), tail, SCM_ARG1, FUNC_NAME, "list");
|
||||
return lst;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
void
|
||||
scm_init_srfi_1 (void)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -37,6 +37,7 @@ SCM_SRFI1_API SCM scm_srfi1_delete (SCM x, SCM lst, SCM pred);
|
|||
SCM_SRFI1_API SCM scm_srfi1_delete_x (SCM x, SCM lst, SCM pred);
|
||||
SCM_SRFI1_API SCM scm_srfi1_delete_duplicates (SCM lst, SCM pred);
|
||||
SCM_SRFI1_API SCM scm_srfi1_delete_duplicates_x (SCM lst, SCM pred);
|
||||
SCM_SRFI1_API SCM scm_srfi1_drop_right (SCM lst, SCM n);
|
||||
SCM_SRFI1_API SCM scm_srfi1_find (SCM pred, SCM lst);
|
||||
SCM_SRFI1_API SCM scm_srfi1_find_tail (SCM pred, SCM lst);
|
||||
SCM_SRFI1_API SCM scm_srfi1_length_plus (SCM lst);
|
||||
|
|
@ -46,7 +47,10 @@ SCM_SRFI1_API SCM scm_srfi1_for_each (SCM proc, SCM arg1, SCM args);
|
|||
SCM_SRFI1_API SCM scm_srfi1_member (SCM obj, SCM ls, SCM pred);
|
||||
SCM_SRFI1_API SCM scm_srfi1_assoc (SCM key, SCM alist, SCM pred);
|
||||
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_take_right (SCM lst, SCM n);
|
||||
|
||||
SCM_SRFI1_API void scm_init_srfi_1 (void);
|
||||
|
||||
|
|
|
|||
|
|
@ -341,24 +341,6 @@
|
|||
(define take list-head)
|
||||
(define drop list-tail)
|
||||
|
||||
(define (take-right flist i)
|
||||
(let lp ((n i) (l flist))
|
||||
(if (<= n 0)
|
||||
(let lp0 ((s flist) (l l))
|
||||
(if (null? l)
|
||||
s
|
||||
(lp0 (cdr s) (cdr l))))
|
||||
(lp (- n 1) (cdr l)))))
|
||||
|
||||
(define (drop-right flist i)
|
||||
(let lp ((n i) (l flist))
|
||||
(if (<= n 0)
|
||||
(let lp0 ((s flist) (l l) (acc '()))
|
||||
(if (null? l)
|
||||
(reverse! acc)
|
||||
(lp0 (cdr s) (cdr l) (cons (car s) acc))))
|
||||
(lp (- n 1) (cdr l)))))
|
||||
|
||||
(define (take! x i)
|
||||
(if (<= i 0)
|
||||
'()
|
||||
|
|
@ -568,14 +550,6 @@
|
|||
(lp (map1 cdr l) (cons res rl))
|
||||
(lp (map1 cdr l) rl)))))))
|
||||
|
||||
;;; Filtering & partitioning
|
||||
|
||||
(define (partition! pred list)
|
||||
(partition pred list)) ; XXX:optimize
|
||||
|
||||
(define (remove! pred list)
|
||||
(filter! (lambda (x) (not (pred x))) list))
|
||||
|
||||
;;; Searching
|
||||
|
||||
(define (take-while pred ls)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue