mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
srfi-1 delete delete!: move from C to Scheme
* libguile/srfi-1.c (scm_srfi1_delete, scm_srfi1_delete_x): delete. * libguile/srfi-1.h (scm_srfi1_delete, scm_srfi1_delete_x): delete. * module/srfi/srfi-1.scm: add delete and delete!.
This commit is contained in:
Rob Browning
parent
c5f26d4c27
commit
a816b2484b
3 changed files with 35 additions and 113 deletions
|
|
@ -277,117 +277,6 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1,
|
|||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_srfi1_delete, "delete", 2, 1, 0,
|
||||
(SCM x, SCM lst, SCM pred),
|
||||
"Return a list containing the elements of @var{lst} but with\n"
|
||||
"those equal to @var{x} deleted. The returned elements will be\n"
|
||||
"in the same order as they were in @var{lst}.\n"
|
||||
"\n"
|
||||
"Equality is determined by @var{pred}, or @code{equal?} if not\n"
|
||||
"given. An equality call is made just once for each element,\n"
|
||||
"but the order in which the calls are made on the elements is\n"
|
||||
"unspecified.\n"
|
||||
"\n"
|
||||
"The equality calls are always @code{(pred x elem)}, ie.@: the\n"
|
||||
"given @var{x} is first. This means for instance elements\n"
|
||||
"greater than 5 can be deleted with @code{(delete 5 lst <)}.\n"
|
||||
"\n"
|
||||
"@var{lst} is not modified, but the returned list might share a\n"
|
||||
"common tail with @var{lst}.")
|
||||
#define FUNC_NAME s_scm_srfi1_delete
|
||||
{
|
||||
SCM ret, *p, keeplst;
|
||||
int count;
|
||||
|
||||
if (SCM_UNBNDP (pred))
|
||||
return scm_delete (x, lst);
|
||||
|
||||
SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG3, FUNC_NAME);
|
||||
|
||||
/* ret is the return list being constructed. p is where to append to it,
|
||||
initially &ret then SCM_CDRLOC of the last pair. lst progresses as
|
||||
elements are considered.
|
||||
|
||||
Elements to be retained are not immediately copied, instead keeplst is
|
||||
the last pair in lst which is to be retained but not yet copied, count
|
||||
is how many from there are wanted. When there's no more deletions, *p
|
||||
can be set to keeplst to share the remainder of the original lst. (The
|
||||
entire original lst if there's no deletions at all.) */
|
||||
|
||||
keeplst = lst;
|
||||
count = 0;
|
||||
p = &ret;
|
||||
|
||||
for ( ; scm_is_pair (lst); lst = SCM_CDR (lst))
|
||||
{
|
||||
if (scm_is_true (scm_call_2 (pred, x, SCM_CAR (lst))))
|
||||
{
|
||||
/* delete this element, so copy those at keeplst */
|
||||
p = list_copy_part (keeplst, count, p);
|
||||
keeplst = SCM_CDR (lst);
|
||||
count = 0;
|
||||
}
|
||||
else
|
||||
{
|
||||
/* keep this element */
|
||||
count++;
|
||||
}
|
||||
}
|
||||
|
||||
/* final retained elements */
|
||||
*p = keeplst;
|
||||
|
||||
/* demand that lst was a proper list */
|
||||
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list");
|
||||
|
||||
return ret;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_srfi1_delete_x, "delete!", 2, 1, 0,
|
||||
(SCM x, SCM lst, SCM pred),
|
||||
"Return a list containing the elements of @var{lst} but with\n"
|
||||
"those equal to @var{x} deleted. The returned elements will be\n"
|
||||
"in the same order as they were in @var{lst}.\n"
|
||||
"\n"
|
||||
"Equality is determined by @var{pred}, or @code{equal?} if not\n"
|
||||
"given. An equality call is made just once for each element,\n"
|
||||
"but the order in which the calls are made on the elements is\n"
|
||||
"unspecified.\n"
|
||||
"\n"
|
||||
"The equality calls are always @code{(pred x elem)}, ie.@: the\n"
|
||||
"given @var{x} is first. This means for instance elements\n"
|
||||
"greater than 5 can be deleted with @code{(delete 5 lst <)}.\n"
|
||||
"\n"
|
||||
"@var{lst} may be modified to construct the returned list.")
|
||||
#define FUNC_NAME s_scm_srfi1_delete_x
|
||||
{
|
||||
SCM walk;
|
||||
SCM *prev;
|
||||
|
||||
if (SCM_UNBNDP (pred))
|
||||
return scm_delete_x (x, lst);
|
||||
|
||||
SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG3, FUNC_NAME);
|
||||
|
||||
for (prev = &lst, walk = lst;
|
||||
scm_is_pair (walk);
|
||||
walk = SCM_CDR (walk))
|
||||
{
|
||||
if (scm_is_true (scm_call_2 (pred, x, SCM_CAR (walk))))
|
||||
*prev = SCM_CDR (walk);
|
||||
else
|
||||
prev = SCM_CDRLOC (walk);
|
||||
}
|
||||
|
||||
/* demand the input was a proper list */
|
||||
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (walk), walk, SCM_ARG2, FUNC_NAME,"list");
|
||||
return lst;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_srfi1_delete_duplicates, "delete-duplicates", 1, 1, 0,
|
||||
(SCM lst, SCM pred),
|
||||
"Return a list containing the elements of @var{lst} but without\n"
|
||||
|
|
|
|||
|
|
@ -29,8 +29,6 @@ SCM_INTERNAL SCM scm_srfi1_append_reverse_x (SCM revhead, SCM tail);
|
|||
SCM_INTERNAL SCM scm_srfi1_concatenate (SCM lstlst);
|
||||
SCM_INTERNAL SCM scm_srfi1_concatenate_x (SCM lstlst);
|
||||
SCM_INTERNAL SCM scm_srfi1_count (SCM pred, SCM list1, SCM rest);
|
||||
SCM_INTERNAL SCM scm_srfi1_delete (SCM x, SCM lst, SCM pred);
|
||||
SCM_INTERNAL SCM scm_srfi1_delete_x (SCM x, SCM lst, SCM pred);
|
||||
SCM_INTERNAL SCM scm_srfi1_delete_duplicates (SCM lst, SCM pred);
|
||||
SCM_INTERNAL SCM scm_srfi1_delete_duplicates_x (SCM lst, SCM pred);
|
||||
SCM_INTERNAL SCM scm_srfi1_length_plus (SCM lst);
|
||||
|
|
|
|||
|
|
@ -982,6 +982,41 @@ CLIST1 ... CLISTN, that satisfies PRED."
|
|||
(else
|
||||
(lp (map cdr lists) (+ i 1)))))))
|
||||
|
||||
;;; Deletion
|
||||
|
||||
(define* (delete x lst #:optional (pred equal?))
|
||||
"Return a list containing the elements of @var{lst} but with
|
||||
those equal to @var{x} deleted. The returned elements will be in the
|
||||
same order as they were in @var{lst}.
|
||||
|
||||
Equality is determined by @var{pred}, or @code{equal?} if not given. An
|
||||
equality call is made just once for each element, but the order in which
|
||||
the calls are made on the elements is unspecified.
|
||||
|
||||
The equality calls are always @code{(pred x elem)}, ie.@: the given
|
||||
@var{x} is first. This means for instance elements greater than 5 can
|
||||
be deleted with @code{(delete 5 lst <)}.
|
||||
|
||||
@var{lst} is not modified, but the returned list might share a common
|
||||
tail with @var{lst}."
|
||||
(remove (lambda (elem) (pred x elem)) lst))
|
||||
|
||||
(define* (delete! x lst #:optional (pred equal?))
|
||||
"Return a list containing the elements of @var{lst} but with
|
||||
those equal to @var{x} deleted. The returned elements will be in the
|
||||
same order as they were in @var{lst}.
|
||||
|
||||
Equality is determined by @var{pred}, or @code{equal?} if not given. An
|
||||
equality call is made just once for each element, but the order in which
|
||||
the calls are made on the elements is unspecified.
|
||||
|
||||
The equality calls are always @code{(pred x elem)}, ie.@: the given
|
||||
@var{x} is first. This means for instance elements greater than 5 can
|
||||
be deleted with @code{(delete 5 lst <)}.
|
||||
|
||||
@var{lst} may be modified to construct the returned list."
|
||||
(remove! (lambda (elem) (pred x elem)) lst))
|
||||
|
||||
;;; Association lists
|
||||
|
||||
(define alist-cons acons)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue