The lambda calculus in Racket / Scheme

lambda-calculus.scm

#lang lazy

; - single argument procedures are the only thing
; - nothing else

(define (TRUE x)
  (lambda (y) x))

(define (FALSE x)
  (lambda (y) y))

(define (NOT x)
  ((x FALSE) TRUE))

(define (AND x)
  (lambda (y) ((x y) x)))

(define (OR x)
  (lambda (y) ((x x) y)))

; numbers
(define (ZERO f)
  (lambda (x) x))

(define (ONE f)
  (lambda (x) (f x)))

(define (TWO f)
  (lambda (x) (f (f x))))

(define (THREE f)
  (lambda (x) (f (f (f x)))))

(define (FOUR f)
  (lambda (x) (f (f (f (f x))))))

; Counting
(define (SUCC n)      ; n is a number (function like ^^)
  (lambda (f)
    (lambda (x)
      (f ((n f) x)))))

(define (ADD x)
  (lambda (y)
    (SUCC y) x))

; x * y
; z is returned
(define (MULT x)
  (lambda (y)
    (lambda (z)
      (x (y z)))))

(define (EXP x)
  (lambda (y)
    (lambda (z)
      ((y x) z))))

; pairs
(define (CONS a)
  (lambda (b)
    (lambda (z) ((z a) b))))

; first in pair
(define (CAR p)
  (p (lambda (a) (lambda (b) a))))

; second in pair
(define (CDR p)
  (p (lambda (a) (lambda (b) b))))

(define (PHI p)
  ((CONS (SUCC (CAR p))) (CAR p)))

(define (PRED n)
  (CDR ((n PHI) ((CONS ZERO) ZERO))))

(define (SUB x)
  (lambda (y)
    (y PRED) x))

(define (Z? n)
  ((n (lambda (f) FALSE)) TRUE))

; not legal lambda calculus b/c FACT in global namespace and global lookups not allowed
;(define (FACT n)
;  (((Z? n) ONE) ((MULT n) (FACT (PRED n)))))

(define (Y f)
  ((lambda (x) (f (x x)))(lambda (x) (f (x x)))))

(define R (lambda (r)
            (lambda (n)
              (((Z? n) ONE) ((MULT n) (r (PRED n)))))))

(define FACT (Y R))

;;;;;;;;;;;;;;;
; for testing ;
;;;;;;;;;;;;;;;
(define (display-num n)
  (display ((n (lambda (x) (+ x 1))) 0))
  (newline)
)

(display-num (FACT FOUR))