Y combinator and variants

Y.rkt

#lang racket/base
;; Y combinator / Normal Order
(define (Yₙ f)(U (comp     f U)))
;; Y combinator / Applicative Order
(define (Yₐ f)(U (comp/eta f U)))
;; Polyvaradic Y Combinator / Normal Order
(define (Yₙ* . f*) (U (mcomp     f* U)))
;; Polyvaradic Y Combinator / Applicative Order
(define (Yₐ* . f*) (U (mcomp/eta f* U)))

;; U Combinator. Matt Might is the only person I know of who calls it this.
(define (U u)(u u))
;; η equivalent wrapper. ((eta: f ...) x ...) = ((f ...) x ...)
(define-syntax-rule (eta: body ...)
  (λ x* (apply (body ...) x*)))

;;; Composition Variants
(define ((comp     f g) u)(     f (g u)))
(define ((comp/eta f g) u)(eta: f (g u)))
;; ((mcomp (list f ...) g) u) -> (list (apply f (g u)) ...)
(define ((mcomp     f* g) u)
  (map (λ(f)(     apply f (g u))) f*))
(define ((mcomp/eta f* g) u)
  (map (λ(f)(eta: apply f (g u))) f*))


;;; Examples
(define-syntax-rule (rec (f x ...) body ...)
  (Yₐ (λ(f)(λ(x ...) body ...))))
(define-syntax-rule (rec* [(f x ...) body ...] ...)
  (apply values (Yₐ* (λ(f ...)(λ(x ...) body ...)) ...)))

(define fib
  (rec (f x)(if (< x 2) x (+ (f (- x 1))
                             (f (- x 2))))))

(define-values (even? odd?)
  (rec* [(even? n) (if (= n 0) #t (odd?  (sub1 n)))]
        [(odd?  n) (if (= n 0) #f (even? (sub1 n)))]))

(let ([lst '(1 2 3 4 5 6 7 8 9 10)])
  (and (equal? (map fib   lst) '(1 1 2 3 5 8 13 21 34 55))
       (equal? (map even? lst) '(#f #t #f #t #f #t #f #t #f #t))
       (equal? (map odd?  lst) '(#t #f #t #f #t #f #t #f #t #f))))