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

srfi-1 delete-duplicates!: move from C to Scheme

Browse source 
* libguile/srfi-1.c (scm_srfi1_delete-duplicates_x): delete.
* libguile/srfi-1.h (scm_srfi1_delete-duplicates_x): delete.
* module/srfi/srfi-1.scm: add delete-duplicates!.
This commit is contained in:
Rob Browning 2024-07-18 03:23:27 -05:00
parent 51e15d448f
commit a94b4406b7
3 changed files with 39 additions and 84 deletions
Download patch file Download diff file Expand all files Collapse all files

83
libguile/srfi-1.c
View file

@ -189,89 +189,6 @@ SCM_DEFINE (scm_srfi1_delete_duplicates, "delete-duplicates", 1, 1, 0,
}
#undef FUNC_NAME
SCM_DEFINE (scm_srfi1_delete_duplicates_x, "delete-duplicates!", 1, 1, 0,
(SCM lst, SCM pred),
"Return a list containing the elements of @var{lst} but without\n"
"duplicates.\n"
"\n"
"When elements are equal, only the first in @var{lst} is\n"
"retained. Equal elements can be anywhere in @var{lst}, they\n"
"don't have to be adjacent. The returned list will have the\n"
"retained elements 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. Calls @code{(pred x y)} are made with element @var{x}\n"
"being before @var{y} in @var{lst}. A call is made at most once\n"
"for each combination, but the sequence of the calls across the\n"
"elements is unspecified.\n"
"\n"
"@var{lst} may be modified to construct the returned list.\n"
"\n"
"In the worst case, this is an @math{O(N^2)} algorithm because\n"
"it must check each element against all those preceding it. For\n"
"long lists it is more efficient to sort and then compare only\n"
"adjacent elements.")
#define FUNC_NAME s_scm_srfi1_delete_duplicates_x
{
scm_t_trampoline_2 equal_p;
SCM ret, endret, item, l;
/* ret is the return list, constructed from the pairs in lst. endret is
the last pair of ret, initially the first pair. lst is advanced as
elements are considered. */
/* skip to end if an empty list (or something invalid) */
ret = lst;
if (scm_is_pair (lst))
{
if (SCM_UNBNDP (pred))
equal_p = equal_trampoline;
else
{
SCM_VALIDATE_PROC (SCM_ARG2, pred);
equal_p = scm_call_2;
}
endret = ret;
/* loop over lst elements starting from second */
for (;;)
{
lst = SCM_CDR (lst);
if (! scm_is_pair (lst))
break;
item = SCM_CAR (lst);
/* is item equal to any element from ret to endret (inclusive)? */
l = ret;
for (;;)
{
if (scm_is_true (equal_p (pred, SCM_CAR (l), item)))
break; /* equal, forget this element */
if (scm_is_eq (l, endret))
{
/* not equal to any, so append this pair */
scm_set_cdr_x (endret, lst);
endret = lst;
break;
}
l = SCM_CDR (l);
}
}
/* terminate, in case last element was deleted */
scm_set_cdr_x (endret, SCM_EOL);
}
/* demand that lst was a proper list */
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG1, FUNC_NAME, "list");
return ret;
}
#undef FUNC_NAME
void
scm_register_srfi_1 (void)

1
libguile/srfi-1.h
View file

@ -25,7 +25,6 @@
#include "libguile/scm.h"
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 void scm_register_srfi_1 (void);
SCM_INTERNAL void scm_init_srfi_1 (void);