diff options
Diffstat (limited to 'srfi/srfi-1.c')
-rw-r--r-- | srfi/srfi-1.c | 70 |
1 files changed, 70 insertions, 0 deletions
diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c index 3a80b3162..6c1da2d7b 100644 --- a/srfi/srfi-1.c +++ b/srfi/srfi-1.c @@ -97,6 +97,76 @@ SCM_DEFINE (scm_srfi1_alist_copy, "alist-copy", 1, 0, 0, #undef FUNC_NAME +SCM_DEFINE (scm_srfi1_break, "break", 2, 0, 0, + (SCM pred, SCM lst), + "Return two values, the longest initial prefix of @var{lst}\n" + "whose elements all fail the predicate @var{pred}, and the\n" + "remainder of @var{lst}.\n" + "\n" + "Note that the name @code{break} conflicts with the @code{break}\n" + "binding established by @code{while}. Applications wanting to\n" + "use @code{break} from within a @code{while} loop will need to\n" + "make a new define under a different name.") +#define FUNC_NAME s_scm_srfi1_break +{ + scm_t_trampoline_1 pred_tramp; + SCM ret, *p; + + pred_tramp = scm_trampoline_1 (pred); + SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME); + + ret = SCM_EOL; + p = &ret; + for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) + { + SCM elem = SCM_CAR (lst); + if (scm_is_true (pred_tramp (pred, elem))) + goto done; + + /* want this elem, tack it onto the end of ret */ + *p = scm_cons (elem, SCM_EOL); + p = SCM_CDRLOC (*p); + } + SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list"); + + done: + return scm_values (scm_list_2 (ret, lst)); +} +#undef FUNC_NAME + + +SCM_DEFINE (scm_srfi1_break_x, "break!", 2, 0, 0, + (SCM pred, SCM lst), + "Return two values, the longest initial prefix of @var{lst}\n" + "whose elements all fail the predicate @var{pred}, and the\n" + "remainder of @var{lst}. @var{lst} may be modified to form the\n" + "return.") +#define FUNC_NAME s_scm_srfi1_break_x +{ + SCM upto, *p; + scm_t_trampoline_1 pred_tramp; + + pred_tramp = scm_trampoline_1 (pred); + SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME); + + p = &lst; + for (upto = lst; scm_is_pair (upto); upto = SCM_CDR (upto)) + { + if (scm_is_true (pred_tramp (pred, SCM_CAR (upto)))) + goto done; + + /* want this element */ + p = SCM_CDRLOC (upto); + } + SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (upto), lst, SCM_ARG2, FUNC_NAME, "list"); + + done: + *p = SCM_EOL; + return scm_values (scm_list_2 (lst, upto)); +} +#undef FUNC_NAME + + SCM_DEFINE (scm_srfi1_concatenate, "concatenate", 1, 0, 0, (SCM lstlst), "Construct a list by appending all lists in @var{lstlst}.\n" |