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 lset-difference!: move from C to Scheme

Browse source 
* libguile/srfi-1.c (scm_srfi1_lset-difference_x): delete.
* libguile/srfi-1.h (scm_srfi1_lset-difference_x): delete.
* module/srfi/srfi-1.scm: add lset-difference!.
* test-suite/tests/srfi-1.test: extend lset-difference! tests to cover
lset-difference.
This commit is contained in:
Rob Browning 2024-07-17 23:12:14 -05:00
parent 3eb6afe738
commit 945c97b14d
4 changed files with 71 additions and 115 deletions
Download patch file Download diff file Expand all files Collapse all files

59
libguile/srfi-1.c
View file

@ -272,65 +272,6 @@ SCM_DEFINE (scm_srfi1_delete_duplicates_x, "delete-duplicates!", 1, 1, 0,
}
#undef FUNC_NAME
SCM_DEFINE (scm_srfi1_lset_difference_x, "lset-difference!", 2, 0, 1,
(SCM equal, SCM lst, SCM rest),
"Return @var{lst} with any elements in the lists in @var{rest}\n"
"removed (ie.@: subtracted). For only one @var{lst} argument,\n"
"just that list is returned.\n"
"\n"
"The given @var{equal} procedure is used for comparing elements,\n"
"called as @code{(@var{equal} elem1 elemN)}. The first argument\n"
"is from @var{lst} and the second from one of the subsequent\n"
"lists. But exactly which calls are made and in what order is\n"
"unspecified.\n"
"\n"
"@example\n"
"(lset-difference! eqv? (list 'x 'y)) @result{} (x y)\n"
"(lset-difference! eqv? (list 1 2 3) '(3 1)) @result{} (2)\n"
"(lset-difference! eqv? (list 1 2 3) '(3) '(2)) @result{} (1)\n"
"@end example\n"
"\n"
"@code{lset-difference!} may modify @var{lst} to form its\n"
"result.")
#define FUNC_NAME s_scm_srfi1_lset_difference_x
{
SCM ret, *pos, elem, r, b;
int argnum;
SCM_VALIDATE_PROC (SCM_ARG1, equal);
SCM_VALIDATE_REST_ARGUMENT (rest);
ret = SCM_EOL;
pos = &ret;
for ( ; scm_is_pair (lst); lst = SCM_CDR (lst))
{
elem = SCM_CAR (lst);
for (r = rest, argnum = SCM_ARG3;
scm_is_pair (r);
r = SCM_CDR (r), argnum++)
{
for (b = SCM_CAR (r); scm_is_pair (b); b = SCM_CDR (b))
if (scm_is_true (scm_call_2 (equal, elem, SCM_CAR (b))))
goto next_elem; /* equal to elem, so drop that elem */
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (b), b, argnum, FUNC_NAME,"list");
}
/* elem not equal to anything in later lists, so keep it */
*pos = lst;
pos = SCM_CDRLOC (lst);
next_elem:
;
}
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list");
*pos = SCM_EOL;
return ret;
}
#undef FUNC_NAME
void
scm_register_srfi_1 (void)

1
libguile/srfi-1.h
View file

@ -26,7 +26,6 @@
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_lset_difference_x (SCM equal, SCM lst, SCM rest);
SCM_INTERNAL void scm_register_srfi_1 (void);
SCM_INTERNAL void scm_init_srfi_1 (void);