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 length+: move from C to Scheme

Browse source 
* libguile/srfi-1.c (scm_srfi1_length_plus): delete.
* libguile/srfi-1.h (scm_srfi1_length_plus): delete.
* module/srfi/srfi-1.scm: add length+.
This commit is contained in:
Rob Browning 2024-07-17 19:44:06 -05:00
parent 3cb6309f62
commit 372a52e6aa
4 changed files with 34 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

43
libguile/srfi-1.c
View file

@ -371,49 +371,6 @@ SCM_DEFINE (scm_srfi1_delete_duplicates_x, "delete-duplicates!", 1, 1, 0,
}
#undef FUNC_NAME
SCM_DEFINE (scm_srfi1_length_plus, "length+", 1, 0, 0,
(SCM lst),
"Return the length of @var{lst}, or @code{#f} if @var{lst} is\n"
"circular.")
#define FUNC_NAME s_scm_srfi1_length_plus
{
size_t i = 0;
SCM tortoise = lst;
SCM hare = lst;
do
{
if (!scm_is_pair (hare))
{
if (SCM_NULL_OR_NIL_P (hare))
return scm_from_size_t (i);
else
scm_wrong_type_arg_msg (FUNC_NAME, 1, lst,
"proper or circular list");
}
hare = SCM_CDR (hare);
i++;
if (!scm_is_pair (hare))
{
if (SCM_NULL_OR_NIL_P (hare))
return scm_from_size_t (i);
else
scm_wrong_type_arg_msg (FUNC_NAME, 1, lst,
"proper or circular list");
}
hare = SCM_CDR (hare);
i++;
/* For every two steps the hare takes, the tortoise takes one. */
tortoise = SCM_CDR (tortoise);
}
while (!scm_is_eq (hare, tortoise));
/* If the tortoise ever catches the hare, then the list must contain
a cycle. */
return SCM_BOOL_F;
}
#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"

1
libguile/srfi-1.h
View file

@ -27,7 +27,6 @@
SCM_INTERNAL SCM scm_srfi1_count (SCM pred, SCM list1, SCM rest);
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);
SCM_INTERNAL SCM scm_srfi1_lset_difference_x (SCM equal, SCM lst, SCM rest);
SCM_INTERNAL SCM scm_srfi1_partition (SCM pred, SCM list);
SCM_INTERNAL SCM scm_srfi1_partition_x (SCM pred, SCM list);