diff --git a/collects/scheme/list.ss b/collects/scheme/list.ss index 52690333e6..db7e58d29c 100644 --- a/collects/scheme/list.ss +++ b/collects/scheme/list.ss @@ -13,8 +13,8 @@ take append* - add-between - flatten) + flatten + add-between) (define (first x) (if (and (pair? x) (list? x)) @@ -78,6 +78,12 @@ (case-lambda [(ls) (apply append ls)] ; optimize common case [(l . lss) (apply append (apply list* l lss))])) +(define (flatten orig-sexp) + (let loop ([sexp orig-sexp] [acc null]) + (cond [(null? sexp) acc] + [(pair? sexp) (loop (car sexp) (loop (cdr sexp) acc))] + [else (cons sexp acc)]))) + ;; General note: many non-tail recursive, which are just as fast in mzscheme (define (add-between l x) @@ -101,9 +107,3 @@ ;; (if (null? ls) ;; ls ;; (append l (car ls) (loop (cdr ls))))))])) - -(define (flatten orig-sexp) - (let loop ([sexp orig-sexp] [acc null]) - (cond [(null? sexp) acc] - [(pair? sexp) (loop (car sexp) (loop (cdr sexp) acc))] - [else (cons sexp acc)]))) diff --git a/collects/scribblings/reference/pairs.scrbl b/collects/scribblings/reference/pairs.scrbl index ec136fd105..636e254135 100644 --- a/collects/scribblings/reference/pairs.scrbl +++ b/collects/scribblings/reference/pairs.scrbl @@ -529,6 +529,16 @@ must merely start with a chain of at least @scheme[pos] pairs. (take 'non-list 0) ]} +@defproc[(add-between [lst list?] [v any/c]) list?]{ + +Returns a list that is made of items from @scheme[lst], with +@scheme[v] between each two items. + +@examples[#:eval list-eval + (add-between '(x y z) 'or) + (add-between '(x) 'or) +]} + @defproc*[([(append* [lst list?] ... [lsts (listof list?)]) list?] [(append* [lst list?] ... [lsts list?]) any/c])]{ @; Note: this is exactly the same description as the one for string-append* diff --git a/collects/tests/mzscheme/list.ss b/collects/tests/mzscheme/list.ss index ebcc8faaf3..76d3f92aa5 100644 --- a/collects/tests/mzscheme/list.ss +++ b/collects/tests/mzscheme/list.ss @@ -183,13 +183,6 @@ (test '(0 1 0 2 0 3) append* (map (lambda (x) (list 0 x)) '(1 2 3))) (test '(1 2 3 4 5 6 7 8 9) append* '(1 2 3) '(4 5) '((6 7 8) (9)))) -;; ---------- add-between ---------- -(let () - (test '() add-between '() 1) - (test '(9) add-between '(9) 1) - (test '(9 1 8 1 7) add-between '(9 8 7) 1) - (test '(9 (1) 8) add-between '(9 8) '(1))) - ;; ---------- flatten ---------- (let () (define (all-sexps n) @@ -201,4 +194,11 @@ (define (flat? x) (and (list? x) (andmap (lambda (x) (eq? 'x x)) x))) (for ([x sexps]) (test #t flat? (flatten x)))) +;; ---------- add-between ---------- +(let () + (test '() add-between '() 1) + (test '(9) add-between '(9) 1) + (test '(9 1 8 1 7) add-between '(9 8 7) 1) + (test '(9 (1) 8) add-between '(9 8) '(1))) + (report-errs)