mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +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
|
#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_DEFINE (scm_srfi1_delete_duplicates, "delete-duplicates", 1, 1, 0,
|
||||||
(SCM lst, SCM pred),
|
(SCM lst, SCM pred),
|
||||||
"Return a list containing the elements of @var{lst} but without\n"
|
"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 (SCM lstlst);
|
||||||
SCM_INTERNAL SCM scm_srfi1_concatenate_x (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_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 (SCM lst, SCM pred);
|
||||||
SCM_INTERNAL SCM scm_srfi1_delete_duplicates_x (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);
|
SCM_INTERNAL SCM scm_srfi1_length_plus (SCM lst);
|
||||||
|
|
|
||||||
|
|
@ -982,6 +982,41 @@ CLIST1 ... CLISTN, that satisfies PRED."
|
||||||
(else
|
(else
|
||||||
(lp (map cdr lists) (+ i 1)))))))
|
(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
|
;;; Association lists
|
||||||
|
|
||||||
(define alist-cons acons)
|
(define alist-cons acons)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue