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

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

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

revision 1.75 by pfdietz, Sun Jul 27 02:41:52 2003 UTC revision 1.76 by pfdietz, Thu Aug 21 23:10:52 2003 UTC
# Line 1536  the condition to go uncaught if it canno Line 1536  the condition to go uncaught if it canno
1536            (unwind-protect (eval ',form) (return-from done :good))            (unwind-protect (eval ',form) (return-from done :good))
1537            (condition () :good))))            (condition () :good))))
1538       :good))       :good))
1539    
1540    ;;; Binary search on reals
1541    
1542    (defun float-binary-search (fn lo hi)
1543      "FN is a function that, if true for X, is true for all Y > X.
1544       Find the smallest float in [lo,hi] for which the function
1545       return true."
1546      
1547      (assert (functionp fn))
1548      (assert (floatp lo))
1549      (assert (floatp hi))
1550      (assert (<= lo hi))
1551      (assert (funcall fn hi))
1552    
1553      (loop while (<= lo hi)
1554            do (let ((mid (/ (+ lo hi) 2)))
1555                 (if (funcall fn mid)
1556                     (if (= mid hi)
1557                         (return hi)
1558                       (setq hi mid))
1559                   (if (= mid lo)
1560                       (return hi)
1561                     (setq lo mid))))))
1562    
1563                
1564      

Legend:
Removed from v.1.75  
changed lines
  Added in v.1.76

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