Rev | Line | |
---|
[14018] | 1 | ;;;; logical-combinators.scm |
---|
| 2 | ;;;; Kon Lovett, Mar '09 |
---|
| 3 | |
---|
| 4 | (declare |
---|
| 5 | (usual-integrations) |
---|
| 6 | (generic) |
---|
| 7 | (inline) |
---|
| 8 | (local) |
---|
| 9 | (no-procedure-checks) |
---|
| 10 | (bound-to-procedure |
---|
| 11 | ##sys#check-closure) ) |
---|
| 12 | |
---|
| 13 | (module logical-combinators (;export |
---|
| 14 | andf orf) |
---|
| 15 | |
---|
| 16 | (import scheme chicken srfi-1) |
---|
| 17 | |
---|
| 18 | ;; Eager 'or' & 'and' |
---|
| 19 | |
---|
| 20 | (define (andf . args) |
---|
| 21 | (let loop ((args args) (prev #t)) |
---|
| 22 | (if (null? args) prev |
---|
| 23 | (let ((cur (car args))) |
---|
| 24 | (and cur |
---|
| 25 | (loop (cdr args) cur) ) ) ) ) ) |
---|
| 26 | |
---|
| 27 | (define (orf . args) |
---|
| 28 | (let loop ((args args)) |
---|
| 29 | (cond ((null? args) #f) |
---|
| 30 | ((car args) => identity) |
---|
| 31 | (else (loop (cdr args)) ) ) ) ) |
---|
| 32 | |
---|
| 33 | ) ;module logical-combinators |
---|
Note: See
TracBrowser
for help on using the repository browser.