0. #lang racket/base
1. ;; Y combinator / Normal Order
2. (define (Yₙ    f ) (U (comp      f  U)))
3. ;; Y combinator / Applicative Order
4. (define (Yₐ    f ) (U (comp/eta  f  U)))
5. ;; Polyvaradic Y Combinator / Normal Order
6. (define (Yₙ* . f*) (U (mcomp     f* U)))
7. ;; Polyvaradic Y Combinator / Applicative Order
8. (define (Yₐ* . f*) (U (mcomp/eta f* U)))
9.  
10. ;; U Combinator. Matt Might is the only person I know of who calls it this.
11. (define (U u)(u u))
12. ;; η equivalent wrapper. ((eta: f ...) x ...) = ((f ...) x ...)
13. (define-syntax-rule (eta: body ...)
14.   (λ x* (apply (body ...) x*)))
15.  
16. ;;; Composition Variants
17. (define ((comp     f g) u)(     f (g u)))
18. (define ((comp/eta f g) u)(eta: f (g u)))
19. ;; ((mcomp (list f ...) g) u) -> (list (apply f (g u)) ...)
20. (define ((mcomp     f* g) u)
21.   (map (λ(f)(     apply f (g u))) f*))
22. (define ((mcomp/eta f* g) u)
23.   (map (λ(f)(eta: apply f (g u))) f*))
24.  
25.  
26. ;;; Examples
27. (define-syntax-rule (rec (f x ...) body ...)
28.   (Yₐ (λ(f)(λ(x ...) body ...))))
29. (define-syntax-rule (rec* [(f x ...) body ...] ...)
30.   (apply values (Yₐ* (λ(f ...)(λ(x ...) body ...)) ...)))
31.  
32. (define fib
33.   (rec (f x)(if (< x 2) x (+ (f (- x 1))
34.                              (f (- x 2))))))
35.  
36. (define-values (even? odd?)
37.   (rec* [(even? n) (if (= n 0) #t (odd?  (sub1 n)))]
38.         [(odd?  n) (if (= n 0) #f (even? (sub1 n)))]))
39.  
40. (let ([lst '(1 2 3 4 5 6 7 8 9 10)])
41.   (and (equal? (map fib   lst) '(1 1 2 3 5 8 13 21 34 55))
42.        (equal? (map even? lst) '(#f #t #f #t #f #t #f #t #f #t))
43.        (equal? (map odd?  lst) '(#t #f #t #f #t #f #t #f #t #f))))

=>

#t