Extend `add-between'.
New keywords: `#:first', `#:before-last', `#:last', and `#:splice?'.
This commit is contained in:
parent
f7185bec91
commit
728687d9dc
|
@ -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
|
||||
|
|
|
@ -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])]{
|
||||
|
|
|
@ -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 ()
|
||||
|
|
Loading…
Reference in New Issue
Block a user