fix break-at to handle breakpoint of 0 correctly

pull/2/head
Matthew Butterick 10 years ago
parent 0b76ee25ae
commit 151dbac737

@ -90,16 +90,18 @@
[(>= j i) (take (drop xs i) (- j i))] [(>= j i) (take (drop xs i) (- j i))]
[else (error 'sublist (format "starting index ~a is larger than ending index ~a" i j))])) [else (error 'sublist (format "starting index ~a is larger than ending index ~a" i j))]))
(define increasing-positive? (λ(xs) (apply < 0 xs))) (define increasing-nonnegative? (λ(xs) (apply < -1 xs)))
(define increasing-positive-list? (and/c list? increasing-positive?)) (define increasing-nonnegative-list? (and/c list? increasing-nonnegative?))
(define+provide/contract (break-at xs bps) (define+provide/contract (break-at xs bps)
(list? (and/c coerce/list? (or/c empty? increasing-positive-list?)) . -> . (listof list?)) (list? (and/c coerce/list? (or/c empty? increasing-nonnegative-list?)) . -> . (listof list?))
(when (ormap (λ(bp) (>= bp (length xs))) bps) (when (ormap (λ(bp) (>= bp (length xs))) bps)
(error 'break-at (format "breakpoint in ~v is greater than or equal to input list length = ~a" bps (length xs)))) (error 'break-at (format "breakpoint in ~v is greater than or equal to input list length = ~a" bps (length xs))))
;; easier to do back to front, because then the list index for each item won't change during the recursion ;; easier to do back to front, because then the list index for each item won't change during the recursion
(reverse (let loop ([xs xs][bps (reverse bps)]) ;; cons a zero onto bps (which may already start with zero) and then use that as the terminating condition
(if (empty? bps) ;; because breaking at zero means we've reached the start of the list
(reverse (let loop ([xs xs][bps (reverse (cons 0 bps))])
(if (= (car bps) 0)
(cons xs null) ; return whatever's left, because no more splits are possible (cons xs null) ; return whatever's left, because no more splits are possible
(let-values ([(head tail) (split-at xs (car bps))]) (let-values ([(head tail) (split-at xs (car bps))])
(cons tail (loop head (cdr bps)))))))) (cons tail (loop head (cdr bps))))))))

@ -163,6 +163,7 @@
(check-equal? (sublist (range 5) 0 5) '(0 1 2 3 4)) (check-equal? (sublist (range 5) 0 5) '(0 1 2 3 4))
(check-equal? (break-at '(5 6 7 8) '()) '((5 6 7 8))) (check-equal? (break-at '(5 6 7 8) '()) '((5 6 7 8)))
(check-equal? (break-at '(5 6 7 8) '(0)) '((5 6 7 8)))
(check-equal? (break-at '(5 6 7 8) '(1 2 3)) '((5) (6) (7) (8))) (check-equal? (break-at '(5 6 7 8) '(1 2 3)) '((5) (6) (7) (8)))
(check-equal? (break-at '(5 6 7 8) '(1 3)) '((5) (6 7) (8))) (check-equal? (break-at '(5 6 7 8) '(1 3)) '((5) (6 7) (8)))
(check-equal? (break-at '(5 6 7 8) '(1)) (break-at '(5 6 7 8) 1)) (check-equal? (break-at '(5 6 7 8) '(1)) (break-at '(5 6 7 8) 1))

Loading…
Cancel
Save