diff options
author | Ludovic Courtès <ludo@gnu.org> | 2010-10-08 11:03:51 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2010-10-08 15:25:56 +0200 |
commit | 58ee1beabec22eaad41eecf6fdd4c0032b6608e3 (patch) | |
tree | 0ac3ec56ff6e38574c971dea81c4e3b91d7fc90d /libguile/srfi-1.c | |
parent | a6505cb49c0971671bcdc87eb6abbc3204d94d97 (diff) | |
download | guile-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.c | 109 |
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" |