; karate chop

(define-syntax while
  (syntax-rules ()
    ((while pred? body ...)
      (do () ((not pred?)) body ...))))

(define-syntax assert
  (syntax-rules ()
    ((assert expr result)
      (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)
  (assert (chop 3 '#(1)) -1)
  (assert (chop 3 '#(3)) 0)
  (assert (chop 1 '#(1 3 5)) 0)
  (assert (chop 3 '#(1 3 5)) 1)
  (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)