source: project/release/4/combinators/tags/1.2.0/tri-combinators.scm @ 19029

Last change on this file since 19029 was 19029, checked in by Kon Lovett, 10 years ago

Release w/ more stuff.

File size: 1.0 KB
Line 
1;;;; tri-combinators.scm
2;;;; Kon Lovett, Jul '10
3
4(module tri-combinators
5
6  (;export
7    tri tri2 tri3 tri-each tri-all)
8
9  (import
10    scheme
11    chicken)
12
13;;; Hook
14
15;;; Fork
16
17;; Trinary
18
19(define tri
20  (case-lambda
21    ((c f g h)  (lambda (x) (c (f x) (g x) (h x))))
22    ((f g h)    (lambda (c) (tri c f g h)))
23    ((c)        (lambda (f g h) (tri c f g h)))
24    (()         (lambda (c) (tri c)))))
25
26(define tri2
27  (case-lambda
28    ((c f g h)  (lambda (x y) (c (f x y) (g x y) (h x y))))
29    ((f g h)    (lambda (c) (tri2 c f g h)))
30    ((c)        (lambda (f g h) (tri2 c f g h)))
31    (()         (lambda (c) (tri2 c)))))
32
33(define tri3
34  (case-lambda
35    ((c f g h)  (lambda (x y z) (c (f x y z) (g x y z) (h x y z))))
36    ((f g h)    (lambda (c) (tri3 c f g h)))
37    ((c)        (lambda (f g h) (tri3 c f g h)))
38    (()         (lambda (c) (tri3 c)))))
39
40(define (tri-each c f)
41  (lambda (x y z) (c (f x) (f y) (f z))) )
42
43(define (tri-all c f g h)
44  (lambda xs (c (apply f xs) (apply g xs) (apply h xs))) )
45
46) ;module tri-combinators
Note: See TracBrowser for help on using the repository browser.