Extend `add-between'.

New keywords: `#:first', `#:before-last', `#:last', and `#:splice?'.

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)
+(define none (gensym 'none))
-  (cond [(not (list? l)) (raise-argument-error 'add-between "list?" 0 l x)]
+(define (add-between l x #:splice? [splice? #f]
-        [(null? l) null]
+                         #:first [first none] #:last [last none]
-        [(null? (cdr l)) l]
+                         #:before-last [before-last none])
-        [else (cons (car l)
+  (unless (list? l)
-                    (let loop ([l (cdr l)])
+    (raise-argument-error 'add-between "list?" 0 l x))
-                      (if (null? l)
+  (when splice?
-                        null
+    (unless (list? x)
-                        (list* x (car l) (loop (cdr l))))))]))
+      (raise-argument-error 'add-between "list?" 1 l x)))
-
+  (if (or (null? l) (null? (cdr l)))
-;; This is nice for symmetry, but confusing to use, and we can get it using
+    (let* ([r (cond [(eq? last none) '()] [splice? last] [else (list last)])]
-;; something like (append* (add-between l ls)), or even `flatten' for an
+           [r (cond [(null? l) r] [(null? r) l] [(cons (car l) r)])]
-;; arbitrary nesting.
+           [r (cond [(eq? first none) r]
-;; (define (lists-join ls l)
+                    [splice? (append first r)]
-;;   (cond [(null? ls) ls]
+                    [else (cons first r)])])
-;;         [(null? l) ls] ; empty separator
+      r)
-;;         [else (append (car ls)
+    (let* ([r ; main loop (two loops for efficiency, maybe not needed)
-;;                       (let loop ([ls (cdr ls)])
+            (if splice?
-;;                         (if (null? ls)
+              (let ([x (reverse x)]
-;;                           ls
+                    [bl (and (not (eq? before-last none))
-;;                           (append l (car ls) (loop (cdr ls))))))]))
+                             (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

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 y z) 'and)
-  (add-between '(x) 'or)
+  (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])]{

collects/tests/racket/list.rktl

@@ -238,10 +238,50 @@
 
 ;; ---------- add-between ----------
 (let ()
-  (test '()          add-between '() 1)
+  ;; simple cases
-  (test '(9)         add-between '(9) 1)
+  (for ([l  (in-list '(() (x) (x y) (x y z) (x y z w)))]
-  (test '(9 1 8 1 7) add-between '(9 8 7) 1)
+        [r1 (in-list '(() (x) (x 5 y) (x 5 y 5 z) (x 5 y 5 z 5 w)))]
-  (test '(9 (1) 8)   add-between '(9 8) '(1)))
+        [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 ()