; an array of two symbols
(define (make-list n x)
(let loop ((n n) (xs '()))
(if (zero? n) xs
(loop (- n 1) (cons x xs)))))
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
((_ "z" f b e (v range fst pst stp) c ...)
(let* ((x fst) (p pst) (s stp)
(le? (if (positive? s) <= >=)))
(do ((v x (+ v s))) ((le? p v) b)
(fold-of "z" f b e c ...))))
((_ "z" f b e (v range fst pst) c ...)
(let* ((x fst) (p pst) (s (if (< x p) 1 -1)))
(fold-of "z" f b e (v range x p s) c ...)))
((_ "z" f b e (v range pst) c ...)
(fold-of "z" f b e (v range 0 pst) c ...))
((_ "z" f b e (x in xs) c ...)
(do ((t xs (cdr t))) ((null? t) b)
(let ((x (car t)))
(fold-of "z" f b e c ...))))
((_ "z" f b e (x is y) c ...)
(let ((x y)) (fold-of "z" f b e c ...)))
((_ "z" f b e p? c ...)
(if p? (fold-of "z" f b e c ...)))
((_ f i e c ...)
(let ((b i)) (fold-of "z" f b e c ...)))))
(define-syntax list-of (syntax-rules ()
((_ arg ...) (reverse (fold-of
(lambda (d a) (cons a d)) '() arg ...)))))
(define (f vec)
(let ((len (vector-length vec)))
(let loop ((lo 0) (hi 1))
(when verbose? (display "first loop: ")
(display lo) (display " ") (display hi) (newline))
(if (zero? (vector-ref vec hi))
(loop hi (max (+ hi hi) (- len 1)))
(let loop ((lo lo) (hi hi))
(let ((mid (quotient (+ lo hi) 2)))
(when verbose? (display "second loop: ")
(display lo) (display " ") (display mid)
(display " ") (display hi) (newline))
(cond ((= lo hi) hi)
((zero? (vector-ref vec mid))
(loop (+ mid 1) hi))
(else (loop lo mid)))))))))
(define verbose? #t)
(display (f '#(0 0 1 1 1 1))) (newline)
(define (test n)
(list-of (list vec result)
(x range 1 n)
(y range 1 n)
(vec is (list->vector (append (make-list x 0) (make-list y 1))))
(result is (f vec))
(or (not (= (vector-ref vec result) 1))
(not (= (vector-ref vec (- result 1)) 0)))))
(set! verbose? #f)
(display (test 100))