diff options
Diffstat (limited to 'libguile')
| -rw-r--r-- | libguile/ChangeLog | 2 | ||||
| -rw-r--r-- | libguile/list.c | 61 | ||||
| -rw-r--r-- | libguile/list.h | 4 |
3 files changed, 65 insertions, 2 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index a11364aae..afb2bcdbd 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,7 @@ 2003-03-11 Mikael Djurfeldt <djurfeldt@nada.kth.se> + * list.c, list.h (scm_filter, scm_filter_x): New functions. + * modules.c (scm_module_import_interface): New function. * goops.c, goops.h (scm_class_accessor_method): Renamed from diff --git a/libguile/list.c b/libguile/list.c index e62ad5b37..41ff2c3fb 100644 --- a/libguile/list.c +++ b/libguile/list.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,2000,2001, 2003 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -47,6 +47,7 @@ #include "libguile/validate.h" #include "libguile/list.h" +#include "libguile/eval.h" #ifdef __STDC__ #include <stdarg.h> @@ -830,6 +831,64 @@ SCM_DEFINE (scm_delete1_x, "delete1!", 2, 0, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_filter, "filter", 2, 0, 0, + (SCM pred, SCM list), + "Return all the elements of 2nd arg @var{list} that satisfy predicate @var{pred}.\n" + "The list is not disordered -- elements that appear in the result list occur\n" + "in the same order as they occur in the argument list. The returned list may\n" + "share a common tail with the argument list. The dynamic order in which the\n" + "various applications of pred are made is not specified.\n\n" + "@lisp\n" + "(filter even? '(0 7 8 8 43 -4)) => (0 8 8 -4)\n" + "@end lisp") +#define FUNC_NAME s_scm_filter +{ + scm_t_trampoline_1 call = scm_trampoline_1 (pred); + SCM walk; + SCM *prev; + SCM res = SCM_EOL; + SCM_ASSERT (call, pred, 1, FUNC_NAME); + SCM_VALIDATE_LIST (2, list); + + for (prev = &res, walk = list; + SCM_CONSP (walk); + walk = SCM_CDR (walk)) + { + if (!SCM_FALSEP (call (pred, SCM_CAR (walk)))) + { + *prev = scm_cons (SCM_CAR (walk), SCM_EOL); + prev = SCM_CDRLOC (*prev); + } + } + + return res; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_filter_x, "filter!", 2, 0, 0, + (SCM pred, SCM list), + "Linear-update variant of @code{filter}.") +#define FUNC_NAME s_scm_filter_x +{ + scm_t_trampoline_1 call = scm_trampoline_1 (pred); + SCM walk; + SCM *prev; + SCM_ASSERT (call, pred, 1, FUNC_NAME); + SCM_VALIDATE_LIST (2, list); + + for (prev = &list, walk = list; + SCM_CONSP (walk); + walk = SCM_CDR (walk)) + { + if (!SCM_FALSEP (call (pred, SCM_CAR (walk)))) + prev = SCM_CDRLOC (walk); + else + *prev = SCM_CDR (walk); + } + + return list; +} +#undef FUNC_NAME void diff --git a/libguile/list.h b/libguile/list.h index 8fc71992c..3eef19444 100644 --- a/libguile/list.h +++ b/libguile/list.h @@ -3,7 +3,7 @@ #ifndef SCM_LIST_H #define SCM_LIST_H -/* Copyright (C) 1995,1996,1997,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,2000,2001, 2003 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -86,6 +86,8 @@ SCM_API SCM scm_delete (SCM item, SCM lst); SCM_API SCM scm_delq1_x (SCM item, SCM lst); SCM_API SCM scm_delv1_x (SCM item, SCM lst); SCM_API SCM scm_delete1_x (SCM item, SCM lst); +SCM_API SCM scm_filter (SCM pred, SCM list); +SCM_API SCM scm_filter_x (SCM pred, SCM list); SCM_API void scm_init_list (void); #endif /* SCM_LIST_H */ |