/[gcl]/gcl/ansi-tests/numbers-aux.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/numbers-aux.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.23 by pfdietz, Tue Jun 22 12:40:34 2004 UTC revision 1.24 by pfdietz, Sun Dec 5 13:55:14 2004 UTC
# Line 31  Line 31 
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

Legend:
Removed from v.1.23  
changed lines
  Added in v.1.24

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26