diff --git a/collects/racket/list.rkt b/collects/racket/list.rkt index 7ffdc149d7..35d42a5680 100644 --- a/collects/racket/list.rkt +++ b/collects/racket/list.rkt @@ -175,29 +175,50 @@ [(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 +;; General note: many non-tail recursive, which are just as fast in racket -(define (add-between l x) - (cond [(not (list? l)) (raise-argument-error 'add-between "list?" 0 l x)] - [(null? l) null] - [(null? (cdr l)) l] - [else (cons (car l) - (let loop ([l (cdr l)]) - (if (null? l) - null - (list* x (car l) (loop (cdr l))))))])) - -;; This is nice for symmetry, but confusing to use, and we can get it using -;; something like (append* (add-between l ls)), or even `flatten' for an -;; arbitrary nesting. -;; (define (lists-join ls l) -;; (cond [(null? ls) ls] -;; [(null? l) ls] ; empty separator -;; [else (append (car ls) -;; (let loop ([ls (cdr ls)]) -;; (if (null? ls) -;; ls -;; (append l (car ls) (loop (cdr ls))))))])) +(define none (gensym 'none)) +(define (add-between l x #:splice? [splice? #f] + #:first [first none] #:last [last none] + #:before-last [before-last none]) + (unless (list? l) + (raise-argument-error 'add-between "list?" 0 l x)) + (when splice? + (unless (list? x) + (raise-argument-error 'add-between "list?" 1 l x))) + (if (or (null? l) (null? (cdr l))) + (let* ([r (cond [(eq? last none) '()] [splice? last] [else (list last)])] + [r (cond [(null? l) r] [(null? r) l] [(cons (car l) r)])] + [r (cond [(eq? first none) r] + [splice? (append first r)] + [else (cons first r)])]) + r) + (let* ([r ; main loop (two loops for efficiency, maybe not needed) + (if splice? + (let ([x (reverse x)] + [bl (and (not (eq? before-last none)) + (reverse before-last))]) + (let loop ([i (cadr l)] [l (cddr l)] [r '()]) + (cond [(pair? l) (loop (car l) (cdr l) (cons i (append x r)))] + [bl (cons i (append bl r))] + [else (cons i (append x r))]))) + (let loop ([i (cadr l)] [l (cddr l)] [r '()]) + (cond [(pair? l) (loop (car l) (cdr l) (cons i (cons x r)))] + [(eq? before-last none) (cons i (cons x r))] + [else (cons i (cons before-last r))])))] + ;; add `last' + [r (cond [(eq? last none) r] + [splice? (append (reverse last) r)] + [else (cons last r)])] + ;; reverse + [r (reverse r)] + ;; add first item + [r (cons (car l) r)] + ;; add `first' + [r (cond [(eq? first none) r] + [splice? (append first r)] + [else (cons first r)])]) + r))) (define (remove-duplicates l [=? equal?] #:key [key #f]) ;; `no-key' is used to optimize the case for long lists, it could be done for diff --git a/collects/scribblings/reference/pairs.scrbl b/collects/scribblings/reference/pairs.scrbl index d660d3ae2e..324d3ebf25 100644 --- a/collects/scribblings/reference/pairs.scrbl +++ b/collects/scribblings/reference/pairs.scrbl @@ -860,15 +860,39 @@ except that it can be faster. (split-at-right '(1 2 3 4 5 6) 4) ]} -@defproc[(add-between [lst list?] [v any/c]) list?]{ +@defproc[(add-between [lst list?] [v any/c] + [#:before-last before-last any/c v] + [#:first first any/c ....] + [#:last last any/c ....] + [#:splice? splice? any/c #f]) + list?]{ Returns a list with the same elements as @racket[lst], but with -@racket[v] between each pair of items in @racket[lst]. +@racket[v] between each pair of items in @racket[lst]. The last pair of +items will have @racket[before-last] between them, which defaults to +@racket[v]. Giving a value for @racket[first] (or @racket[last]) +will make the result have that value added to its beginning (or end). @mz-examples[#:eval list-eval - (add-between '(x y z) 'or) - (add-between '(x) 'or) -]} + (add-between '(x y z) 'and) + (add-between '(x) 'and) + (add-between '("a" "b" "c" "d") "," #:before-last "and") + (add-between #:first "Todo:" + '("a" "b" "c") "," #:before-last "and" + #:last ".") +] + +If @racket[splice?] is true, then @racket[v], @racket[before-last], +@racket[first], and @racket[last] should be lists, and their values are +spliced into the result. + +@mz-examples[#:eval list-eval + (add-between '(x y z) '(-) #:before-last '(- -) + #:first '(begin) #:last '(end LF) + #:splice? #t) +] + +} @defproc*[([(append* [lst list?] ... [lsts (listof list?)]) list?] [(append* [lst list?] ... [lsts list?]) any/c])]{ diff --git a/collects/tests/racket/list.rktl b/collects/tests/racket/list.rktl index 51b78e320a..9d0c1d9a68 100644 --- a/collects/tests/racket/list.rktl +++ b/collects/tests/racket/list.rktl @@ -238,10 +238,50 @@ ;; ---------- 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))) + ;; simple cases + (for ([l (in-list '(() (x) (x y) (x y z) (x y z w)))] + [r1 (in-list '(() (x) (x 5 y) (x 5 y 5 z) (x 5 y 5 z 5 w)))] + [r2 (in-list '(() (x) (x 7 y) (x 5 y 7 z) (x 5 y 5 z 7 w)))] + [r3 (in-list '(() (x) (x (5) y) (x (5) y (5) z) + (x (5) y (5) z (5) w)))]) + (test r1 add-between l 5) + (test `(0 ,@r1) add-between l 5 #:first 0) + (test `(,@r1 9) add-between l 5 #:last 9) + (test `(0 ,@r1 9) add-between l 5 #:first 0 #:last 9) + (test r2 add-between l 5 #:before-last 7) + (test `(0 ,@r2) add-between l 5 #:first 0 #:before-last 7) + (test `(,@r2 9) add-between l 5 #:last 9 #:before-last 7) + (test `(0 ,@r2 9) add-between l 5 #:first 0 #:last 9 #:before-last 7) + (test r3 add-between l '(5)) + (test `(0 ,@r3) add-between l '(5) #:first 0) + (test `(,@r3 9) add-between l '(5) #:last 9) + (test `(0 ,@r3 9) add-between l '(5) #:first 0 #:last 9)) + ;; spliced cases + (for* ([x (in-list '(() (4) (4 5)))] + [y (in-list '(() (6) (6 7)))]) + (for ([l (in-list '(() (x) (x y) (x y z) (x y z w)))] + [r1 (in-list `(() (x) (x ,@x y) (x ,@x y ,@x z) + (x ,@x y ,@x z ,@x w)))] + [r2 (in-list `(() (x) (x ,@y y) (x ,@x y ,@y z) + (x ,@x y ,@x z ,@y w)))]) + (test r1 add-between l x #:splice? #t) + (test r2 add-between l x #:splice? #t #:before-last y) + (for ([fst (in-list '(() (0) (0 1)))]) + (test `(,@fst ,@r1) add-between l x + #:splice? #t #:first fst) + (test `(,@fst ,@r2) add-between l x + #:splice? #t #:first fst #:before-last y)) + (for ([lst (in-list '(() (9) (8 9)))]) + (test `(,@r1 ,@lst) add-between l x + #:splice? #t #:last lst) + (test `(,@r2 ,@lst) add-between l x + #:splice? #t #:last lst #:before-last y)) + (for* ([fst (in-list '(() (0) (0 1)))] + [lst (in-list '(() (9) (8 9)))]) + (test `(,@fst ,@r1 ,@lst) add-between l x + #:splice? #t #:first fst #:last lst) + (test `(,@fst ,@r2 ,@lst) add-between l x + #:splice? #t #:first fst #:last lst #:before-last y))))) ;; ---------- remove-duplicates ---------- (let ()