diff --git a/collects/racket/list.rkt b/collects/racket/list.rkt index eef34514b5..fe32f68ba4 100644 --- a/collects/racket/list.rkt +++ b/collects/racket/list.rkt @@ -177,58 +177,58 @@ ;; General note: many non-tail recursive, which are just as fast in racket -(define default-nothing (gensym 'nothing)) -(define (add-between l x +(define (add-between l x #:splice? [splice? #f] - #:nothing [nothing default-nothing] - #:before-first [before-first nothing] + #:before-first [before-first '()] #:before-last [before-last x] - #:after-last [after-last nothing]) + #:after-last [after-last '()]) (unless (list? l) (raise-argument-error 'add-between "list?" 0 l x)) - (when splice? - (define (check-list x which) - (unless (list? x) - (raise-arguments-error 'add-between - (string-append "list needed in splicing mode" which) - "given" x - "given list..." l))) - (check-list x "") - (unless (eq? nothing before-first) (check-list before-first " for #:before-first")) - (check-list before-last " for #:before-last") - (unless (eq? nothing after-last) (check-list after-last " for #:after-last"))) - (if (or (null? l) (null? (cdr l))) - (let* ([r (cond [(eq? after-last nothing) '()] [splice? after-last] [else (list after-last)])] - [r (cond [(null? l) r] [(null? r) l] [(cons (car l) r)])] - [r (cond [(eq? before-first nothing) r] - [splice? (append before-first r)] - [else (cons before-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 x)) - (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)))] - [else (cons i (cons before-last r))])))] - ;; add `after-last' - [r (cond [(eq? after-last nothing) r] - [splice? (append (reverse after-last) r)] - [else (cons after-last r)])] - ;; reverse - [r (reverse r)] - ;; add first item - [r (cons (car l) r)] - ;; add `before-first' - [r (cond [(eq? before-first nothing) r] - [splice? (append before-first r)] - [else (cons before-first r)])]) - r))) + (cond + [splice? + (define (check-list x which) + (unless (list? x) + (raise-arguments-error + 'add-between + (string-append "list needed in splicing mode" which) + "given" x + "given list..." l))) + (check-list x "") + (check-list before-first " for #:before-first") + (check-list before-last " for #:before-last") + (check-list after-last " for #:after-last")] + [else + (define (check-not-given x which) + (unless (eq? '() x) + (raise-arguments-error + 'add-between + (string-append which " can only be used in splicing mode") + "given" x + "given list..." l))) + (check-not-given before-first "#:before-first") + (check-not-given after-last "#:after-last")]) + (cond + [(or (null? l) (null? (cdr l))) + (if splice? (append before-first l after-last) l)] + ;; two cases for efficiency, maybe not needed + [splice? + (let* ([x (reverse x)] + ;; main loop + [r (let loop ([i (cadr l)] [l (cddr l)] [r '()]) + (if (pair? l) + (loop (car l) (cdr l) (cons i (append x r))) + (cons i (append (reverse before-last) r))))] + ;; add `after-last' & reverse + [r (reverse (append (reverse after-last) r))] + ;; add first item and `before-first' + [r `(,@before-first ,(car l) ,@r)]) + r)] + [else + (cons (car l) + (reverse (let loop ([i (cadr l)] [l (cddr l)] [r '()]) ; main loop + (if (pair? l) + (loop (car l) (cdr l) (cons i (cons x r))) + (cons i (cons before-last 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 447e874aee..6078b74025 100644 --- a/collects/scribblings/reference/pairs.scrbl +++ b/collects/scribblings/reference/pairs.scrbl @@ -862,41 +862,30 @@ except that it can be faster. @defproc[(add-between [lst list?] [v any/c] - [#:nothing nothing any/c (gensym)] - [#:before-first before-first any/c nothing] + [#:before-first before-first list? '()] [#:before-last before-last any/c v] - [#:after-last after-last any/c nothing] + [#:after-last after-last list? '()] [#:splice? splice? any/c #f]) list?]{ Returns a list with the same elements as @racket[lst], but with @racket[v] between each pair of elements in @racket[lst]; the last pair of elements will have @racket[before-last] between them, instead -of @racket[v] (but @racket[before-last] defaults to @racket[v]). In -addition, if @racket[before-first] is supplied as a value other than -@racket[nothing], then @racket[before-first] is inserted before the first -element; if @racket[after-last] is supplied as a value other than -@racket[nothing], then @racket[after-last] is inserted after the last -element. +of @racket[v] (but @racket[before-last] defaults to @racket[v]). -If @racket[splice?] is true, then @racket[v], @racket[before-first], -@racket[before-last], and @racket[after-last] should be lists, and -the list elements are spliced into the result. +If @racket[splice?] is true, then @racket[v] and @racket[before-last] +should be lists, and the list elements are spliced into the result. In +addition, when @racket[splice?] is true, @racket[before-first] and +@racket[after-last] are inserted before the first element and after the +last element respectively. @mz-examples[#:eval list-eval (add-between '(x y z) 'and) (add-between '(x) 'and) (add-between '("a" "b" "c" "d") "," #:before-last "and") - (add-between #:before-first "Todo:" - '("a" "b" "c") "," #:before-last "and" - #:after-last ".") (add-between '(x y z) '(-) #:before-last '(- -) #:before-first '(begin) #:after-last '(end LF) #:splice? #t) - (add-between '("a" "b" "c" "d") "," - #:nothing #f #:before-first #f #:after-last "!") - (add-between '("a" "b" "c" "d") "," - #:before-first #f #:after-last "!") ]} diff --git a/collects/tests/racket/list.rktl b/collects/tests/racket/list.rktl index 8c14a3979b..4701146326 100644 --- a/collects/tests/racket/list.rktl +++ b/collects/tests/racket/list.rktl @@ -245,19 +245,20 @@ [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 #:before-first 0) - (test `(,@r1 9) add-between l 5 #:after-last 9) - (test `(0 ,@r1 9) add-between l 5 #:before-first 0 #:after-last 9) + ;; (test `(0 ,@r1) add-between l 5 #:before-first 0) + ;; (test `(,@r1 9) add-between l 5 #:after-last 9) + ;; (test `(0 ,@r1 9) add-between l 5 #:before-first 0 #:after-last 9) (test r2 add-between l 5 #:before-last 7) - (test `(0 ,@r2) add-between l 5 #:before-first 0 #:before-last 7) - (test `(,@r2 9) add-between l 5 #:after-last 9 #:before-last 7) - (test `(0 ,@r2 9) add-between l 5 #:before-first 0 #:after-last 9 #:before-last 7) + ;; (test `(0 ,@r2) add-between l 5 #:before-first 0 #:before-last 7) + ;; (test `(,@r2 9) add-between l 5 #:after-last 9 #:before-last 7) + ;; (test `(0 ,@r2 9) add-between l 5 #:before-first 0 #:after-last 9 #:before-last 7) (test r3 add-between l '(5)) - (test `(0 ,@r3) add-between l '(5) #:before-first 0) - (test `(,@r3 9) add-between l '(5) #:after-last 9) - (test `(0 ,@r3 9) add-between l '(5) #:before-first 0 #:after-last 9) - (test r1 add-between l 5 #:nothing #f #:before-first #f) - (test r1 add-between l 5 #:nothing #f #:after-last #f)) + ;; (test `(0 ,@r3) add-between l '(5) #:before-first 0) + ;; (test `(,@r3 9) add-between l '(5) #:after-last 9) + ;; (test `(0 ,@r3 9) add-between l '(5) #:before-first 0 #:after-last 9) + ;; (test r1 add-between l 5 #:nothing #f #:before-first #f) + ;; (test r1 add-between l 5 #:nothing #f #:after-last #f) + ) ;; spliced cases (for* ([x (in-list '(() (4) (4 5)))] [y (in-list '(() (6) (6 7)))])