summaryrefslogtreecommitdiff
path: root/srfi/srfi-1.c
diff options
context:
space:
mode:
Diffstat (limited to 'srfi/srfi-1.c')
-rw-r--r--srfi/srfi-1.c70
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"