(break, break!): Rewrite in C.

diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c
index 3a80b31..6c1da2d 100644 (file)
--- 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 63896ed..83f3da6 100644 (file)
--- 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 24b0e0d..7e1fcf4 100644 (file)
--- 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)