Last change
on this file since 21916 was
19028,
checked in by Kon Lovett, 11 years ago

Export Schemeish uni, etc. & argumentsX routines

File size:
1.2 KB

Rev  Line  

[19028]  1  ;;;; bicombinators.scm 

 2  ;;;; Kon Lovett, Jul '10 

 3  

 4  (module bicombinators 

 5  

 6  (;export 

 7  bi bi2 bi3 bieach biall) 

 8  

 9  (import 

 10  scheme 

 11  chicken) 

 12  

 13  # 

 14  ;;; Hook 

 15  

 16  ;; Binary 

 17  

 18  (define (bieachleft c f) 

 19  (lambda (x y) (c (f x) (f y) x y)) ) 

 20  

 21  (define (bieachright c f) 

 22  (lambda (x y) (c x y (f x) (f y))) ) 

 23  

 24  (define (biallleft c f g) 

 25  (lambda xs (apply c (apply f xs) (apply g xs) xs)) ) 

 26  

 27  (define (biallright c f g) 

 28  (lambda xs (apply c (append xs (list (apply f xs) (apply g xs))))) ) 

 29  # 

 30  

 31  ;;; Fork 

 32  

 33  ;; Binary 

 34  

 35  (define bi 

 36  (caselambda 

 37  ((c f g) (lambda (x) (c (f x) (g x)))) 

 38  ((f g) (lambda (c) (bi c f g))) 

 39  ((c) (lambda (f g) (bi c f g))) 

 40  (() (lambda (c) (bi c))))) 

 41  

 42  (define bi2 

 43  (caselambda 

 44  ((c f g) (lambda (x y) (c (f x y) (g x y)))) 

 45  ((f g) (lambda (c) (bi2 c f g))) 

 46  ((c) (lambda (f g) (bi2 c f g))) 

 47  (() (lambda (c) (bi2 c))))) 

 48  

 49  (define bi3 

 50  (caselambda 

 51  ((c f g) (lambda (x y z) (c (f x y z) (g x y z)))) 

 52  ((f g) (lambda (c) (bi3 c f g))) 

 53  ((c) (lambda (f g) (bi3 c f g))) 

 54  (() (lambda (c) (bi3 c))))) 

 55  

 56  (define (bieach c f) 

 57  (lambda (x y) (c (f x) (f y))) ) 

 58  

 59  (define (biall c f g) 

 60  (lambda xs (c (apply f xs) (apply g xs))) ) 

 61  

 62  ) ;module bicombinators 

Note: See
TracBrowser
for help on using the repository browser.