Last change
on this file since 31138 was
31138,
checked in by felix winkelmann, 6 years ago
|
added preliminary eggs for extraction from core libraries
|
File size:
763 bytes
|
Line | |
---|
1 | ;;; Binary search |
---|
2 | |
---|
3 | |
---|
4 | (module binary-search (binary-search) |
---|
5 | |
---|
6 | (import scheme chicken) |
---|
7 | |
---|
8 | (define (binary-search seq proc) |
---|
9 | (let-values (((seq len) |
---|
10 | (cond ((pair? seq) |
---|
11 | (let ((seq (list->vector seq))) |
---|
12 | (values seq (vector-length seq)))) |
---|
13 | ((vector? seq) |
---|
14 | (values seq (vector-length seq))) |
---|
15 | ((fixnum? seq) (values #f seq)) |
---|
16 | (else (error 'binary-search "invalid sequence" seq))))) |
---|
17 | (and (fx> len 0) |
---|
18 | (let loop ((ps 0) |
---|
19 | (pe len) ) |
---|
20 | (let ((p (fx+ ps (##core#inline "C_fixnum_shift_right" (fx- pe ps) 1)))) |
---|
21 | (let* ((x (if seq (##sys#slot seq p) p)) |
---|
22 | (r (proc x)) ) |
---|
23 | (cond ((fx= r 0) p) |
---|
24 | ((fx< r 0) (and (not (fx= pe p)) (loop ps p))) |
---|
25 | (else (and (not (fx= ps p)) (loop p pe))) ) ) ) ) ) ) ) |
---|
26 | |
---|
27 | ) |
---|
Note: See
TracBrowser
for help on using the repository browser.