; floor and ceiling in an array

(define xs '#(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47))

(define (floor-ceiling lt? x xs)
  (let* ((len (vector-length xs)) (len-1 (- len 1)))
    (if (lt? x (vector-ref xs 0)) (list -1 0)
      (if (lt? (vector-ref xs (- len 1)) x) (list len-1 len)
        (let loop ((lo 0) (hi len-1))
          (let ((mid (+ lo (quotient (- hi lo) 2))))
            (cond ((< hi lo) (list hi lo))
                  ((lt? x (vector-ref xs mid)) (loop lo (- mid 1)))
                  ((lt? (vector-ref xs mid) x) (loop (+ mid 1) hi))
                  (else (list mid mid)))))))))

(define (test)
  (do ((x 0 (+ x 1))) ((= x 50))
    (let ((fc (floor-ceiling < x xs)) (len (vector-length xs)))
      (when (< (cadr fc) (car fc))
        (display "what? ") (display x) (display " ") (display fc) (newline))
      (if (= (cadr fc) len)
          (when (not (< (vector-ref xs (- len 1)) x))
            (display "bad ceiling ") (display x) (display " ") (display fc) (newline))
        (when (< (vector-ref xs (cadr fc)) x)
          (display "bad ceiling ") (display x) (display " ") (display fc) (newline)))
      (if (= (car fc) -1)
          (when (not (< x (vector-ref xs 0)))
            (display "bad floor ") (display x) (display " ") (display fc) (newline))
          (when (< x (vector-ref xs (car fc)))
            (display "bad floor ") (display x) (display fc) (newline))))))