summaryrefslogtreecommitdiff
path: root/libguile/srfi-1.c
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2010-10-08 11:03:51 +0200
committerLudovic Courtès <ludo@gnu.org>2010-10-08 15:25:56 +0200
commit58ee1beabec22eaad41eecf6fdd4c0032b6608e3 (patch)
tree0ac3ec56ff6e38574c971dea81c4e3b91d7fc90d /libguile/srfi-1.c
parenta6505cb49c0971671bcdc87eb6abbc3204d94d97 (diff)
downloadguile-58ee1beabec22eaad41eecf6fdd4c0032b6608e3.tar.gz
SRFI-1: Rewrite `filter-map' in Scheme.
This partially reverts commit c16359466bcc3f2ebf6d750c069f787f629fc625 (Thu Mar 17 2005). * libguile/srfi-1.c (scm_srfi1_filter_map): Remove. * libguile/srfi-1.h (scm_srfi1_filter_map): Ditto. * module/srfi/srfi-1.scm (filter-map): New procedure.
Diffstat (limited to 'libguile/srfi-1.c')
-rw-r--r--libguile/srfi-1.c109
1 files changed, 0 insertions, 109 deletions
diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c
index 2fb677a7a..6d5a1ab90 100644
--- a/libguile/srfi-1.c
+++ b/libguile/srfi-1.c
@@ -616,115 +616,6 @@ SCM_DEFINE (scm_srfi1_drop_right, "drop-right", 2, 0, 0,
}
#undef FUNC_NAME
-SCM_DEFINE (scm_srfi1_filter_map, "filter-map", 2, 0, 1,
- (SCM proc, SCM list1, SCM rest),
- "Apply @var{proc} to to the elements of @var{list1} @dots{} and\n"
- "return a list of the results as per SRFI-1 @code{map}, except\n"
- "that any @code{#f} results are omitted from the list returned.")
-#define FUNC_NAME s_scm_srfi1_filter_map
-{
- SCM ret, *loc, elem, newcell, lst;
- int argnum;
-
- SCM_VALIDATE_REST_ARGUMENT (rest);
-
- ret = SCM_EOL;
- loc = &ret;
-
- if (scm_is_null (rest))
- {
- /* one list */
- SCM_VALIDATE_PROC (SCM_ARG1, proc);
-
- for ( ; scm_is_pair (list1); list1 = SCM_CDR (list1))
- {
- elem = scm_call_1 (proc, SCM_CAR (list1));
- if (scm_is_true (elem))
- {
- newcell = scm_cons (elem, SCM_EOL);
- *loc = newcell;
- loc = SCM_CDRLOC (newcell);
- }
- }
-
- /* check below that list1 is a proper list, and done */
- end_list1:
- lst = list1;
- argnum = 2;
- }
- else if (scm_is_null (SCM_CDR (rest)))
- {
- /* two lists */
- SCM list2 = SCM_CAR (rest);
- SCM_VALIDATE_PROC (SCM_ARG1, proc);
-
- for (;;)
- {
- if (! scm_is_pair (list1))
- goto end_list1;
- if (! scm_is_pair (list2))
- {
- lst = list2;
- argnum = 3;
- goto check_lst_and_done;
- }
- elem = scm_call_2 (proc, SCM_CAR (list1), SCM_CAR (list2));
- if (scm_is_true (elem))
- {
- newcell = scm_cons (elem, SCM_EOL);
- *loc = newcell;
- loc = SCM_CDRLOC (newcell);
- }
- 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 proc, 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 proc */
- SCM_SIMPLE_VECTOR_SET (vec, i, SCM_CDR (lst)); /* rest of lst */
- }
-
- elem = scm_apply (proc, args, SCM_EOL);
- if (scm_is_true (elem))
- {
- newcell = scm_cons (elem, SCM_EOL);
- *loc = newcell;
- loc = SCM_CDRLOC (newcell);
- }
- }
- }
-
- check_lst_and_done:
- SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, argnum, FUNC_NAME, "list");
- return ret;
-}
-#undef FUNC_NAME
-
-
SCM_DEFINE (scm_srfi1_find, "find", 2, 0, 0,
(SCM pred, SCM lst),
"Return the first element of @var{lst} which satisfies the\n"