Skip to content

Instantly share code, notes, and snippets.

@Glorp
Created December 11, 2014 23:21
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save Glorp/4866af501897710148ca to your computer and use it in GitHub Desktop.
Save Glorp/4866af501897710148ca to your computer and use it in GitHub Desktop.
#lang racket
(require (only-in racket
(+ old+)))
(define (dechurch n)
(n (λ (i) (old+ i 1)) 0))
(define (zero f x)
x)
(define (one f x)
(f x))
(define (two f x)
(f (f x)))
(define (succ n)
(λ (f x) (f (n f x))))
(define (+ a b)
(λ (f x) (a f (b f x))))
(define (* a b)
(a (λ (n) (b succ n)) zero))
(define (cons a b)
(λ (f) (f a b)))
(define (car c)
(c (λ (a b) a)))
(define (cdr c)
(c (λ (a b) b)))
(define three (succ two))
(define six (+ three three))
(define (pred n)
(car (n (λ (c) (cons (cdr c) (succ (cdr c))))
(cons zero zero))))
(define (- a b)
(b pred a))
(define (true a b)
a)
(define (false a b)
b)
(define (if p c a)
((p c a)))
(define (not p)
(λ (a b) (p b a)))
(define (and a b)
(if a (λ () b) (λ () false)))
(define (zero? n)
(n (λ (_) false) true))
(define (<= a b)
(zero? (- a b)))
(define (= a b)
(and (<= a b) (<= b a)))
(define y
(λ (x)
((λ (proc)
(x (λ (arg) ((proc proc) arg))))
(λ (proc)
(x (λ (arg) ((proc proc) arg)))))))
(define fib
(y
(λ (f) (λ (n)
(if (<= n one)
(λ () n)
(λ () (+ (f (- n one)) (f (- n two)))))))))
(dechurch (fib (+ six (+ two (+ two two)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment