31 |
(return hi) |
(return hi) |
32 |
(setq lo mid)))))) |
(setq lo mid)))))) |
33 |
|
|
34 |
|
(defun integer-binary-search (fn lo hi) |
35 |
|
|
36 |
|
"FN is a function that, if true for X, is true for all Y < X. |
37 |
|
Find the largest integer in [lo,hi) for which the function |
38 |
|
return true." |
39 |
|
|
40 |
|
(assert (functionp fn)) |
41 |
|
(assert (integerp lo)) |
42 |
|
(assert (integerp hi)) |
43 |
|
(assert (<= lo hi)) |
44 |
|
(assert (funcall fn lo)) |
45 |
|
|
46 |
|
(loop while (< lo hi) |
47 |
|
do (let ((mid (ceiling (+ lo hi) 2))) |
48 |
|
(if (funcall fn mid) |
49 |
|
(setq lo mid) |
50 |
|
(if (= mid hi) |
51 |
|
(return lo) |
52 |
|
(setq hi mid)))))) |
53 |
|
|
54 |
|
(defun find-largest-exactly-floatable-integer (upper-bound) |
55 |
|
(integer-binary-search |
56 |
|
#'(lambda (i) |
57 |
|
(let* ((f (float i)) |
58 |
|
(i- (1- i)) |
59 |
|
(f- (float i-))) |
60 |
|
(and (= f i) (= f- i-)))) |
61 |
|
0 upper-bound)) |
62 |
|
|
63 |
(defun eqlzt (x y) |
(defun eqlzt (x y) |
64 |
"Return T if (eql x y) or if both are zero of the same type." |
"Return T if (eql x y) or if both are zero of the same type." |
65 |
(cond |
(cond |