; karate chop
(define-syntax while
(syntax-rules ()
((while pred? body ...)
(do () ((not pred?)) body ...))))
(syntax-rules ()
(if (not (equal? expr result))
(for-each display `(
#\newline "failed assertion:" #\newline
expr #\newline "expected: " ,result
#\newline "returned: " ,expr #\newline))))))
(define (test chop)
(assert (chop 3 '#(1)) -1)
(assert (chop 1 '#(1 3 5)) 0)
(assert (chop 5 '#(1 3 5)) 2)
(assert (chop
0 '#(1 3 5)) -1) (assert (chop 2 '#(1 3 5)) -1)
(assert (chop
4 '#(1 3 5)) -1) (assert (chop 6 '#(1 3 5)) -1)
(assert (chop
1 '#(1 3 5 7)) 0) (assert (chop 3 '#(1 3 5 7)) 1)
(assert (chop
5 '#(1 3 5 7)) 2) (assert (chop 7 '#(1 3 5 7)) 3)
(assert (chop
0 '#(1 3 5 7)) -1) (assert (chop 2 '#(1 3 5 7)) -1)
(assert (chop
4 '#(1 3 5 7)) -1) (assert (chop 6 '#(1 3 5 7)) -1)
(assert (chop
8 '#(1 3 5 7)) -1))
(define (chop1 needle haystack)
(call-with-current-continuation
(lambda (return)
(let ((lo 0) (hi (- (vector-length haystack) 1)))
(while (<= lo hi)
(let ((mid (quotient (+ lo hi) 2)))
(cond ((< needle (vector-ref haystack mid))
(set! hi (- mid 1)))
((< (vector-ref haystack mid) needle)
(set! lo (+ mid 1)))
(else (return mid)))))
(return -1)))))
(test chop1)
(define (chop2 needle haystack)
(chop2-aux needle haystack 0 (- (vector-length haystack) 1)))
(define (chop2-aux needle haystack lo hi)
(call-with-current-continuation
(lambda (return)
(if (< hi lo) (return -1)
(let ((mid (quotient (+ lo hi) 2)))
(cond ((< needle (vector-ref haystack mid))
(return (chop2-aux needle haystack lo (- mid 1))))
((< (vector-ref haystack mid) needle)
(return (chop2-aux needle haystack (+ mid 1) hi)))
(else (return mid))))))))
(test chop2)
(define (chop3 needle haystack)
(let loop ((lo 0) (hi (- (vector-length haystack) 1)))
(if (< hi lo) -1
(let ((mid (quotient (+ lo hi) 2)))
(cond ((< needle (vector-ref haystack mid))
(loop lo (- mid 1)))
((< (vector-ref haystack mid) needle)
(loop (+ mid 1) hi))
(else mid))))))
(test chop3)
(define (chop4 needle haystack)
(call-with-current-continuation
(lambda (return)
(let ((lo 0) (hi (- (vector-length haystack) 1)))
(while (< lo hi)
(let ((mid (quotient (+ lo hi) 2)))
(if (< (vector-ref haystack mid) needle)
(set! lo (+ mid 1))
(set! hi mid))))
(if (and (= lo hi) (= needle (vector-ref haystack lo)))
(return lo)
(return -1))))))
(test chop4)
(define (chop5 needle haystack)
(let loop ((lo 0) (hi (- (vector-length haystack) 1)))
(if (<= hi lo)
(if (and (= lo hi) (= needle (vector-ref haystack lo))) lo -1)
(let ((mid (quotient (+ lo hi) 2)))
(if (< (vector-ref haystack mid) needle)
(loop (+ mid 1) hi)
(loop lo mid))))))
(test chop5)