1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 01:00:20 +02:00

SRFI-1: Rewrite break' and break!' in Scheme.

This partially reverts commit 6e9f3c2676
(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'.
This commit is contained in:
Ludovic Courtès 2010-08-27 15:43:30 +02:00
parent d7418e60a5
commit b86d230932
3 changed files with 61 additions and 64 deletions

View file

@ -472,6 +472,30 @@ that result. See the manual for details."
;;; Searching
(define (break pred clist)
"Return two values, the longest initial prefix of LST whose elements
all fail the predicate PRED, and the remainder of LST."
(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)
"Linear-update variant of `break'."
(let loop ((l list)
(prev #f))
(cond ((null? l)
(values list '()))
((pred (car l))
(if (pair? prev)
(begin
(set-cdr! prev '())
(values list l))
(values '() list)))
(else
(loop (cdr l) l)))))
(define (any pred ls . lists)
(if (null? lists)
(any1 pred ls)