summaryrefslogtreecommitdiff
path: root/srfi/srfi-1.c
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2010-08-27 15:43:30 +0200
committerLudovic Courtès <ludo@gnu.org>2010-08-27 18:59:42 +0200
commitb86d23093284512a6a3c1780e9e5547c9ab34c25 (patch)
treecb6c52c23b3edf548b41658728ea4d926ca0227c /srfi/srfi-1.c
parentd7418e60a5b427a9d733929cf6ff468402dada1d (diff)
downloadguile-b86d23093284512a6a3c1780e9e5547c9ab34c25.tar.gz
SRFI-1: Rewrite `break' and `break!' in Scheme.
This partially reverts commit 6e9f3c2676c0101590d4229653e9c628cb293064 (Tue May 3 2005). * module/srfi/srfi-1.scm (break, break!): New procedures. * srfi/srfi-1.c (scm_srfi1_break, scm_srfi1_break_x): Rewrite as proxies to the corresponding Scheme procedures. * test-suite/standalone/test-srfi-1.c (failure): New function. (tests): Add `scm_srfi1_break' test. Use `failure'.
Diffstat (limited to 'srfi/srfi-1.c')
-rw-r--r--srfi/srfi-1.c69
1 files changed, 8 insertions, 61 deletions
diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c
index dc19dd226..02c580d97 100644
--- a/srfi/srfi-1.c
+++ b/srfi/srfi-1.c
@@ -207,72 +207,19 @@ SCM_DEFINE (scm_srfi1_append_reverse_x, "append-reverse!", 2, 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
+scm_srfi1_break (SCM pred, SCM lst)
{
- SCM ret, *p;
-
- SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), 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 (scm_call_1 (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));
+ CACHE_VAR (break_proc, "break");
+ return scm_call_2 (break_proc, pred, 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
+scm_srfi1_break_x (SCM pred, SCM lst)
{
- SCM upto, *p;
-
- SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME);
-
- p = &lst;
- for (upto = lst; scm_is_pair (upto); upto = SCM_CDR (upto))
- {
- if (scm_is_true (scm_call_1 (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));
+ CACHE_VAR (break_x, "break!");
+ return scm_call_2 (break_x, pred, lst);
}
-#undef FUNC_NAME
-
SCM
scm_srfi1_car_plus_cdr (SCM pair)