Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #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))))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement