diff options
Diffstat (limited to 'libguile/srfi-1.c')
-rw-r--r-- | libguile/srfi-1.c | 99 |
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" |