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

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

Release w/ more stuff.

File size: 2.0 KB
Line 
1;;;; uni-combinators.scm
2;;;; Kon Lovett, Jul '10
3
4(module uni-combinators
5
6  (;export
7    uni uni2 uni3 uni-each uni-all)
8
9  (import
10    scheme
11    chicken)
12
13#|
14;;; Hook
15
16;; Unary
17
18(define uni-left
19  (case-lambda
20    ((c f)  (lambda (x) (c (f x) x)))
21    ((c)    (lambda (f) (uni-left c f)))
22    (()     (lambda (c) (uni-left c)))))
23
24(define uni-right
25  (case-lambda
26    ((c f)  (lambda (x) (c x (f x))))
27    ((c)    (lambda (f) (uni-right c f)))
28    (()     (lambda (c) (uni-right c)))))
29
30(define uni2-left
31  (case-lambda
32    ((c f)  (lambda (x y) (c (f x y) x y)))
33    ((c)    (lambda (f) (uni2-left c f)))
34    (()     (lambda (c) (uni2-left c)))))
35
36(define uni2-right
37  (case-lambda
38    ((c f)  (lambda (x y) (c x y (f x y))))
39    ((c)    (lambda (f) (uni2-right c f)))
40    (()     (lambda (c) (uni2-right c)))))
41
42(define uni3-left
43  (case-lambda
44    ((c f)  (lambda (x y z) (c (f x y z) x y z)))
45    ((c)    (lambda (f) (uni3-left c f)))
46    (()     (lambda (c) (uni3-left c)))))
47
48(define uni3-right
49  (case-lambda
50    ((c f)  (lambda (x y z) (c x y z (f x y z))))
51    ((c)    (lambda (f) (uni3-right c f)))
52    (()     (lambda (c) (uni3-right c)))))
53
54(define (uni-each-left c f)
55  (lambda (x) (c (f x) x)) )
56
57(define (uni-each-right c f)
58  (lambda (x) (c x (f x))) )
59
60(define (uni-all-left c f)
61  (lambda xs (apply c (apply f xs) xs)) )
62
63(define (uni-all-right c f)
64  (lambda xs (apply c (append xs (list (apply f xs))))) )
65|#
66
67;;; Fork
68
69;; Unary
70
71(define uni
72  (case-lambda
73    ((c f)  (lambda (x) (c (f x))))
74    ((c)    (lambda (f) (uni c f)))
75    (()     (lambda (c) (uni c)))))
76
77(define uni2
78  (case-lambda
79    ((c f)  (lambda (x y) (c (f x y))))
80    ((c)    (lambda (f) (uni2 c f)))
81    (()     (lambda (c) (uni2 c)))))
82
83(define uni3
84  (case-lambda
85    ((c f)  (lambda (x y z) (c (f x y z))))
86    ((c)    (lambda (f) (uni3 c f)))
87    (()     (lambda (c) (uni3 c)))))
88
89(define (uni-each c f)
90  (lambda (x) (c (f x))) )
91
92(define (uni-all c f)
93  (lambda xs (c (apply f xs))) )
94
95) ;module uni-combinators
Note: See TracBrowser for help on using the repository browser.