summaryrefslogtreecommitdiff
path: root/libguile/srfi-1.c
diff options
context:
space:
mode:
authorRob Browning <rlb@defaultvalue.org>2024-07-17 21:08:01 -0500
committerRob Browning <rlb@defaultvalue.org>2024-07-30 19:28:37 -0500
commit58246aee24be908307117b3f8ae8040460f86ce7 (patch)
tree1c731b1b7cc27feddf4ba5156042da647525846c /libguile/srfi-1.c
parent372a52e6aa22ac255d8607c9e4f4f43864218440 (diff)
downloadguile-58246aee24be908307117b3f8ae8040460f86ce7.tar.gz
srfi-1 count: move from C to Scheme
* libguile/srfi-1.c (scm_srfi1_count): delete. * libguile/srfi-1.h (scm_srfi1_count): delete. * module/srfi/srfi-1.scm: add count.
Diffstat (limited to 'libguile/srfi-1.c')
-rw-r--r--libguile/srfi-1.c99
1 files changed, 0 insertions, 99 deletions
diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c
index 798f4e7bb..aaa156d3e 100644
--- a/libguile/srfi-1.c
+++ b/libguile/srfi-1.c
@@ -85,105 +85,6 @@ list_copy_part (SCM lst, int count, SCM *dst)
}
#undef FUNC_NAME
-SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1,
- (SCM pred, SCM list1, SCM rest),
- "Return a count of the number of times @var{pred} returns true\n"
- "when called on elements from the given lists.\n"
- "\n"
- "@var{pred} is called with @var{N} parameters @code{(@var{pred}\n"
- "@var{elem1} @dots{} @var{elemN})}, each element being from the\n"
- "corresponding @var{list1} @dots{} @var{lstN}. The first call is\n"
- "with the first element of each list, the second with the second\n"
- "element from each, and so on.\n"
- "\n"
- "Counting stops when the end of the shortest list is reached.\n"
- "At least one list must be non-circular.")
-#define FUNC_NAME s_scm_srfi1_count
-{
- long count;
- SCM lst;
- int argnum;
- SCM_VALIDATE_REST_ARGUMENT (rest);
-
- count = 0;
-
- if (scm_is_null (rest))
- {
- /* one list */
- SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME);
-
- for ( ; scm_is_pair (list1); list1 = SCM_CDR (list1))
- count += scm_is_true (scm_call_1 (pred, SCM_CAR (list1)));
-
- /* check below that list1 is a proper list, and done */
- end_list1:
- lst = list1;
- argnum = 2;
- }
- else if (scm_is_pair (rest) && scm_is_null (SCM_CDR (rest)))
- {
- /* two lists */
- SCM list2;
-
- SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME);
-
- list2 = SCM_CAR (rest);
- for (;;)
- {
- if (! scm_is_pair (list1))
- goto end_list1;
- if (! scm_is_pair (list2))
- {
- lst = list2;
- argnum = 3;
- break;
- }
- count += scm_is_true (scm_call_2
- (pred, SCM_CAR (list1), SCM_CAR (list2)));
- list1 = SCM_CDR (list1);
- list2 = SCM_CDR (list2);
- }
- }
- else
- {
- /* three or more lists */
- SCM vec, args, a;
- size_t len, i;
-
- /* vec is the list arguments */
- vec = scm_vector (scm_cons (list1, rest));
- len = SCM_SIMPLE_VECTOR_LENGTH (vec);
-
- /* args is the argument list to pass to pred, same length as vec,
- re-used for each call */
- args = scm_make_list (SCM_I_MAKINUM (len), SCM_UNDEFINED);
-
- for (;;)
- {
- /* first elem of each list in vec into args, and step those
- vec entries onto their next element */
- for (i = 0, a = args, argnum = 2;
- i < len;
- i++, a = SCM_CDR (a), argnum++)
- {
- lst = SCM_SIMPLE_VECTOR_REF (vec, i); /* list argument */
- if (! scm_is_pair (lst))
- goto check_lst_and_done;
- SCM_SETCAR (a, SCM_CAR (lst)); /* arg for pred */
- SCM_SIMPLE_VECTOR_SET (vec, i, SCM_CDR (lst)); /* rest of lst */
- }
-
- count += scm_is_true (scm_apply_0 (pred, args));
- }
- }
-
- check_lst_and_done:
- SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, argnum, FUNC_NAME, "list");
- return scm_from_long (count);
-}
-#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"