;; Quine-based binary chop, by Bill Moorier (abstractnonsense.com)



;; We start with the archetypal Lisp quine:

((lambda (x) `(,x ',x)) '(lambda (x) `(,x ',x)))

;; Transform it into a quine that takes four extra arguments:

((lambda (x a b c d) `(,x ',x ,a ,b ,c ,d))
 '(lambda (x a b c d) `(,x ',x ,a ,b ,c ,d)) 1 2 3 4)

;; Now we want it to be a quine if high - low > 2, otherwise
;; it should return low if (aref array low) is n, and -1 if not.
;; We'll also wrap it in a defun and change the variable names a, b, c, d
;; to something more meaningful:

(defun chop1 (array n)
  (let ((low 0)
        (high (array-dimension array 0)))
    ((lambda (x array n low high)
       (if (< (- high low) 2)
           (if (= (aref array low) n)
               low
               -1)
           `(,x ',x ,array ,n ,low ,high)))
     '(lambda (x array n low high)
       (if (< (- high low) 2)
           (if (= (aref array low) n)
               low
               -1)
           `(,x ',x ,array ,n ,low ,high))) array n low high)))

;; Next we need to make it compute halfway, and change low or
;; high to halfway accordingly:

(defun chop2 (array n)
  (let ((low 0)
        (high (array-dimension array 0)))
    ((lambda (x array n low high)
       (let ((halfway (floor (/ (+ low high) 2))))
         (if (< n (aref array halfway))
             (setf high halfway)
             (setf low halfway)))
       (if (< (- high low) 2)
           (if (= (aref array low) n)
               low
               -1)
           `(,x ',x ,array ,n ,low ,high)))
     '(lambda (x array n low high)
       (let ((halfway (floor (/ (+ low high) 2))))
         (if (< n (aref array halfway))
             (setf high halfway)
             (setf low halfway)))
       (if (< (- high low) 2)
           (if (= (aref array low) n)
               low
               -1)
           `(,x ',x ,array ,n ,low ,high))) array n low high)))

;; Finally we make it loop until it's finished:

(defun chop3 (array n)
  (let* ((low 0)
         (high (array-dimension array 0))
         (result ((lambda (x array n low high)
                    (let ((halfway (floor (/ (+ low high) 2))))
                      (if (< n (aref array halfway))
                          (setf high halfway)
                          (setf low halfway)))
                    (if (< (- high low) 2)
                        (if (= (aref array low) n)
                            low
                            -1)
                        `(,x ',x ,array ,n ,low ,high)))
                  '(lambda (x array n low high)
                    (let ((halfway (floor (/ (+ low high) 2))))
                      (if (< n (aref array halfway))
                          (setf high halfway)
                          (setf low halfway)))
                    (if (< (- high low) 2)
                        (if (= (aref array low) n)
                            low
                            -1)
                        `(,x ',x ,array ,n ,low ,high))) array n low high)))
    (loop while (not (numberp result)) do
         (setf result (eval result)))
    result))

(c) 2006, Bill Moorier