1 |
/* Copyright (C) 1995,1996,1997,2000,2001 Free Software Foundation, Inc. |
/* Copyright (C) 1995,1996,1997,2000,2001, 2003 Free Software Foundation, Inc. |
2 |
* |
* |
3 |
* This program is free software; you can redistribute it and/or modify |
* This program is free software; you can redistribute it and/or modify |
4 |
* it under the terms of the GNU General Public License as published by |
* it under the terms of the GNU General Public License as published by |
47 |
|
|
48 |
#include "libguile/validate.h" |
#include "libguile/validate.h" |
49 |
#include "libguile/list.h" |
#include "libguile/list.h" |
50 |
|
#include "libguile/eval.h" |
51 |
|
|
52 |
#ifdef __STDC__ |
#ifdef __STDC__ |
53 |
#include <stdarg.h> |
#include <stdarg.h> |
831 |
} |
} |
832 |
#undef FUNC_NAME |
#undef FUNC_NAME |
833 |
|
|
834 |
|
SCM_DEFINE (scm_filter, "filter", 2, 0, 0, |
835 |
|
(SCM pred, SCM list), |
836 |
|
"Return all the elements of 2nd arg @var{list} that satisfy predicate @var{pred}.\n" |
837 |
|
"The list is not disordered -- elements that appear in the result list occur\n" |
838 |
|
"in the same order as they occur in the argument list. The returned list may\n" |
839 |
|
"share a common tail with the argument list. The dynamic order in which the\n" |
840 |
|
"various applications of pred are made is not specified.\n\n" |
841 |
|
"@lisp\n" |
842 |
|
"(filter even? '(0 7 8 8 43 -4)) => (0 8 8 -4)\n" |
843 |
|
"@end lisp") |
844 |
|
#define FUNC_NAME s_scm_filter |
845 |
|
{ |
846 |
|
scm_t_trampoline_1 call = scm_trampoline_1 (pred); |
847 |
|
SCM walk; |
848 |
|
SCM *prev; |
849 |
|
SCM res = SCM_EOL; |
850 |
|
SCM_ASSERT (call, pred, 1, FUNC_NAME); |
851 |
|
SCM_VALIDATE_LIST (2, list); |
852 |
|
|
853 |
|
for (prev = &res, walk = list; |
854 |
|
SCM_CONSP (walk); |
855 |
|
walk = SCM_CDR (walk)) |
856 |
|
{ |
857 |
|
if (!SCM_FALSEP (call (pred, SCM_CAR (walk)))) |
858 |
|
{ |
859 |
|
*prev = scm_cons (SCM_CAR (walk), SCM_EOL); |
860 |
|
prev = SCM_CDRLOC (*prev); |
861 |
|
} |
862 |
|
} |
863 |
|
|
864 |
|
return res; |
865 |
|
} |
866 |
|
#undef FUNC_NAME |
867 |
|
|
868 |
|
SCM_DEFINE (scm_filter_x, "filter!", 2, 0, 0, |
869 |
|
(SCM pred, SCM list), |
870 |
|
"Linear-update variant of @code{filter}.") |
871 |
|
#define FUNC_NAME s_scm_filter_x |
872 |
|
{ |
873 |
|
scm_t_trampoline_1 call = scm_trampoline_1 (pred); |
874 |
|
SCM walk; |
875 |
|
SCM *prev; |
876 |
|
SCM_ASSERT (call, pred, 1, FUNC_NAME); |
877 |
|
SCM_VALIDATE_LIST (2, list); |
878 |
|
|
879 |
|
for (prev = &list, walk = list; |
880 |
|
SCM_CONSP (walk); |
881 |
|
walk = SCM_CDR (walk)) |
882 |
|
{ |
883 |
|
if (!SCM_FALSEP (call (pred, SCM_CAR (walk)))) |
884 |
|
prev = SCM_CDRLOC (walk); |
885 |
|
else |
886 |
|
*prev = SCM_CDR (walk); |
887 |
|
} |
888 |
|
|
889 |
|
return list; |
890 |
|
} |
891 |
|
#undef FUNC_NAME |
892 |
|
|
893 |
|
|
894 |
void |
void |