diff --git a/collects/racket/list.rkt b/collects/racket/list.rkt index fe32f68ba4..1b6440beb6 100644 --- a/collects/racket/list.rkt +++ b/collects/racket/list.rkt @@ -15,6 +15,8 @@ split-at drop-right take-right + take-while + drop-while split-at-right append* @@ -151,6 +153,29 @@ (cons (car list) (loop (cdr list) (cdr lead))) '()))) +;; taken from srfi-1 and tweaked +(define (take-while pred lis) + (unless (procedure? pred) + (raise-argument-error 'take-while "procedure?" 0 pred lis)) + (unless (list? lis) + (raise-argument-error 'take-while "list?" 1 pred lis)) + (let recur ([lis lis]) + (if (null? lis) '() + (let ([x (car lis)]) + (if (pred x) + (cons x (recur (cdr lis))) + '()))))) + +(define (drop-while pred lis) + (unless (procedure? pred) + (raise-argument-error 'drop-while "procedure?" 0 pred lis)) + (unless (list? lis) + (raise-argument-error 'drop-while "list?" 1 pred lis)) + (let recur ([lis lis]) + (cond [(null? lis) '()] + [(pred (car lis)) (recur (cdr lis))] + [else lis]))) + (define (split-at-right list n) (unless (exact-nonnegative-integer? n) (raise-argument-error 'split-at-right "exact-nonnegative-integer?" n)) diff --git a/collects/scribblings/reference/pairs.scrbl b/collects/scribblings/reference/pairs.scrbl index afa2d49968..82bf402453 100644 --- a/collects/scribblings/reference/pairs.scrbl +++ b/collects/scribblings/reference/pairs.scrbl @@ -821,6 +821,28 @@ Returns the same result as except that it can be faster.} +@defproc[(take-while [pred procedure?] [lst list?]) + list?]{ +Returns a fresh list whose elements are taken successively from +@racket[lst] as long as they satisfy @racket[pred]. The returned +list includes up to, but not including, the first element in +@racket[lst] for which @racket[pred] returns @racket[#f]. + +@mz-examples[#:eval list-eval + (take-while even? '(2 4 5 8)) + (take-while odd? '(2 4 6 8)) +]} + +@defproc[(drop-while [pred procedure?] [lst list?]) + list?]{ +Returns a fresh list with elements successively removed from +@racket[lst] from the front as long as they satisfy @racket[pred]. + +@mz-examples[#:eval list-eval + (drop-while even? '(2 4 5 8)) + (drop-while odd? '(2 4 6 8)) +]} + @defproc[(take-right [lst any/c] [pos exact-nonnegative-integer?]) any/c]{ Returns the @racket[list]'s @racket[pos]-length tail. If @racket[lst] has fewer than @racket[pos] elements, then the diff --git a/collects/tests/racket/list.rktl b/collects/tests/racket/list.rktl index 4701146326..5eacca11a4 100644 --- a/collects/tests/racket/list.rktl +++ b/collects/tests/racket/list.rktl @@ -212,6 +212,23 @@ (err/rt-test (fun '(1) 2) exn:application:mismatch?) (err/rt-test (fun '(1 2 . 3) 3) exn:application:mismatch?))) +;; ---------- take/drop-while ---------- + +(let () + (define list-1 '(2 4 6 8 1 3 5)) + (err/rt-test (take-while 5 '()) exn:application:mismatch?) + (err/rt-test (drop-while 5 '()) exn:application:mismatch?) + (err/rt-test (take-while even? 1) exn:application:mismatch?) + (err/rt-test (drop-while even? 1) exn:application:mismatch?) + (test '(2 4 6 8) take-while even? list-1) + (test '(1 3 5) drop-while even? list-1) + (test '() take-while odd? list-1) + (test list-1 drop-while odd? list-1) + (test list-1 take-while number? list-1) + (test '() drop-while number? list-1) + (test '() take-while list? '()) + (test '() drop-while list? '())) + ;; ---------- append* ---------- (let () (test '() append* '())