summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--srfi/srfi-1.c70
-rw-r--r--srfi/srfi-1.h2
-rw-r--r--srfi/srfi-1.scm10
3 files changed, 72 insertions, 10 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"
diff --git a/srfi/srfi-1.h b/srfi/srfi-1.h
index 63896ed47..83f3da65f 100644
--- a/srfi/srfi-1.h
+++ b/srfi/srfi-1.h
@@ -33,6 +33,8 @@
#endif
SCM_SRFI1_API SCM scm_srfi1_alist_copy (SCM alist);
+SCM_SRFI1_API SCM scm_srfi1_break (SCM pred, SCM lst);
+SCM_SRFI1_API SCM scm_srfi1_break_x (SCM pred, SCM lst);
SCM_SRFI1_API SCM scm_srfi1_concatenate (SCM lstlst);
SCM_SRFI1_API SCM scm_srfi1_concatenate_x (SCM lstlst);
SCM_SRFI1_API SCM scm_srfi1_count (SCM pred, SCM list1, SCM rest);
diff --git a/srfi/srfi-1.scm b/srfi/srfi-1.scm
index 24b0e0d5a..7e1fcf493 100644
--- a/srfi/srfi-1.scm
+++ b/srfi/srfi-1.scm
@@ -482,16 +482,6 @@
;;; Searching
-(define (break pred clist)
- (let lp ((clist clist) (rl '()))
- (if (or (null? clist)
- (pred (car clist)))
- (values (reverse! rl) clist)
- (lp (cdr clist) (cons (car clist) rl)))))
-
-(define (break! pred list)
- (break pred list)) ; XXX:optimize
-
(define (any pred ls . lists)
(if (null? lists)
(any1 pred ls)