diff options
author | Kevin Ryde <user42@zip.com.au> | 2005-03-13 22:49:28 +0000 |
---|---|---|
committer | Kevin Ryde <user42@zip.com.au> | 2005-03-13 22:49:28 +0000 |
commit | 5df2ac97e96d1ab8422d39034f8076a3e8741a3a (patch) | |
tree | c23becdfc338f27de15fef25aeaa3ac4a1efe6b7 | |
parent | 68513144456f575409acb9c640347f7c954d6579 (diff) | |
download | guile-5df2ac97e96d1ab8422d39034f8076a3e8741a3a.tar.gz |
(find, find-tail): Rewrite in C.
-rw-r--r-- | srfi/srfi-1.c | 43 | ||||
-rw-r--r-- | srfi/srfi-1.h | 2 | ||||
-rw-r--r-- | srfi/srfi-1.scm | 14 |
3 files changed, 45 insertions, 14 deletions
diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c index 961fa537b..1adcba6dc 100644 --- a/srfi/srfi-1.c +++ b/srfi/srfi-1.c @@ -473,6 +473,49 @@ SCM_DEFINE (scm_srfi1_delete_duplicates_x, "delete-duplicates!", 1, 1, 0, #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" + "predicate @var{pred}, or return @code{#f} if no such element is\n" + "found.") +#define FUNC_NAME s_scm_srfi1_find +{ + scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (pred); + SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME); + + for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) + { + SCM elem = SCM_CAR (lst); + if (scm_is_true (pred_tramp (pred, elem))) + return elem; + } + SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list"); + + return SCM_BOOL_F; +} +#undef FUNC_NAME + + +SCM_DEFINE (scm_srfi1_find_tail, "find-tail", 2, 0, 0, + (SCM pred, SCM lst), + "Return the first pair of @var{lst} whose @sc{car} satisfies the\n" + "predicate @var{pred}, or return @code{#f} if no such element is\n" + "found.") +#define FUNC_NAME s_scm_srfi1_find_tail +{ + scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (pred); + SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME); + + for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) + if (scm_is_true (pred_tramp (pred, SCM_CAR (lst)))) + return lst; + SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list"); + + return SCM_BOOL_F; +} +#undef FUNC_NAME + + SCM_DEFINE (scm_srfi1_length_plus, "length+", 1, 0, 0, (SCM lst), "Return the length of @var{lst}, or @code{#f} if @var{lst} is\n" diff --git a/srfi/srfi-1.h b/srfi/srfi-1.h index bf14f2db3..636345d0a 100644 --- a/srfi/srfi-1.h +++ b/srfi/srfi-1.h @@ -37,6 +37,8 @@ SCM_SRFI1_API SCM scm_srfi1_delete (SCM x, SCM lst, SCM pred); SCM_SRFI1_API SCM scm_srfi1_delete_x (SCM x, SCM lst, SCM pred); SCM_SRFI1_API SCM scm_srfi1_delete_duplicates (SCM lst, SCM pred); SCM_SRFI1_API SCM scm_srfi1_delete_duplicates_x (SCM lst, SCM pred); +SCM_SRFI1_API SCM scm_srfi1_find (SCM pred, SCM lst); +SCM_SRFI1_API SCM scm_srfi1_find_tail (SCM pred, SCM lst); SCM_SRFI1_API SCM scm_srfi1_length_plus (SCM lst); SCM_SRFI1_API SCM scm_srfi1_list_copy (SCM lst); SCM_SRFI1_API SCM scm_srfi1_map (SCM proc, SCM arg1, SCM args); diff --git a/srfi/srfi-1.scm b/srfi/srfi-1.scm index 11ec3c2f2..aec63890f 100644 --- a/srfi/srfi-1.scm +++ b/srfi/srfi-1.scm @@ -578,20 +578,6 @@ ;;; Searching -(define (find pred clist) - (if (null? clist) - #f - (if (pred (car clist)) - (car clist) - (find pred (cdr clist))))) - -(define (find-tail pred clist) - (if (null? clist) - #f - (if (pred (car clist)) - clist - (find-tail pred (cdr clist))))) - (define (take-while pred ls) (cond ((null? ls) '()) ((not (pred (car ls))) '()) |