Basic lambda calculus

Jun 03, 2012 01:03


Functions are "first class citizens" (Cristopher Strachey, mid-1960s).

; DISCLAIMER: THE DRAFT BELOW IS NOT INTENDED TO BE THE PURE LAMBDA CALCULUS; ; FOR EXAMPLE, THERE ARE METHODS LIKE define AND display. NEVERTHELESS, ; HAVING ENOUGH PASSION IT'S QUITE EASY TO TRANSFORM THEM TO THE PURE FORM. ;------------------------- ; (Very) Basic I/O (define newline (lambda () (display "\n"))) ; display is a predefined function in my ; self-written parser ;------------------------- ; Basic Combinator ; identity (define identity (lambda (x) x)) ; Y- and Z- combinators will be defined later ;------------------------- ; Boolean Logic (define true (lambda (x) (lambda (y) x))) (define false (lambda (x) (lambda (y) y))) (define and (lambda (p) (lambda (q) ((p q) false)))) ; Reduction of (and p q) gives true if and only if both p and q are ; equals to true, otherwise it results into false. ; (expand and) ; I was dreaming of "expand" function implementation to get the final lambda- ; statement, but the problem is I have close to little motivation to finish this, ; so I'm leaving this comment as a letter to the future. (define or (lambda (p) (lambda (q) ((p true) q)))) (define not (lambda (p) ((p false) true))) (define xor (lambda (p) (lambda (q) ((p ((q false) true)) q)))) (define equal (lambda (p) (lambda (q) (not ((xor p) q))))) (dispb ((equal true) false)) ; => false (newline) (dispb (not ((xor false) true))) ; => false (newline) ; if selector (define if (lambda (p) (lambda (x) (lambda (y) ((p x) y))))) ;------------------------- ; Basic unit-test (define assert-equal (lambda (x) (lambda (y) (((if ((equal x) y)) (display "OK")) (display "Fail!")) (newline)))) (dispb (((if true) false) true)) ; => false (newline) (dispb (((if false) false) true)) ; => true (newline) ;------------------------- ; Basic arithmetics with natural numbers (define zero (lambda (f) (lambda (x) x))) ; N.B. zero is false just like in many languages! (define one (lambda (f) (lambda (x) (f x)))) (dispn one) ; => 1 (newline) ; Zero checking ; A numeral c is represented by a function that applies any function ; to its argument exactly n times. ; Zero predicate: say we have a function (and false), so zero ; applications of it to an argument true returns true, however if we ; apply it one or more times to the true argument, it will return false. (define zerop (lambda (n) ((n (lambda (x) false)) true))) (dispb (zerop zero)) ; => true (newline) (dispb (zerop false)) ; => true (newline) (dispb (zerop one)) ; => false (newline) (define two (lambda (f) (lambda (x) (f (f x))))) (dispn two) ; => 2 (newline) (define succ (lambda (c) (lambda (x) (lambda (y) (x ((c x) y)))))) (define three (succ two)) (define four (succ three)) (dispn four) ; => 4 (newline) (define sum (lambda (m) (lambda (n) (lambda (f) (lambda (x) ((m f) ((n f) x))))))) (define five ((sum two) three)) (dispn five) ; => 5 (newline) (dispn ((sum two) four)) ; => 6 (newline) ; "sum" can be thought of as a function taking two natural ; numbers as arguments and returning a natural number; ; since adding m to a number n can be accomplished by adding 1 m times (define sum-alt (lambda (m) (lambda (n) ((m succ) n)))) (dispn ((sum-alt two) four)) ; => 6 (newline) (define mul (lambda (c) (lambda (d) (lambda (f) (c (d f)))))) (dispn ((mul two) five)) ; => 10 (newline) (dispn ((mul zero) four)) ; => 0 (newline) ; since multiplying m and n is the same as repeating ; the add n function m times and then applying it to zero. (define mul-alt (lambda (m) (lambda (n) ((m (sum n)) zero)))) (dispn ((mul-alt two) five)) ; => 10 (newline) ; rather ugly definition of prev predicate, however a classic one, a ; bit later we'll define way much elegant predicate (define pred (lambda (n) (lambda (f) (lambda (x) (((n (lambda (g) (lambda (h) (h (g f))))) (lambda (u) x)) (lambda (u) u)))))) (dispn (pred five)) ; => 4 (newline) ; having true and false definitions we can simplify prev predicate ; by using if-then-else expression. however it still looks ugly. ; we'll define a good one soon. (define pred-alt (lambda (n) (((n (lambda (g) (lambda (k) (((zerop (g one)) k) ((sum (g k)) one))))) (lambda (v) zero)) zero))) (dispn (pred-alt five)) ; => 4 (newline) ; subtraction works in a trivial way: subtract 1 from m number n times (define sub (lambda (m) (lambda (n) ((n pred) m)))) (dispn ((sub five) three)) ; => 2 (newline) ; poor man Y-combinator (define Z (lambda (f) ((lambda (g) (f (lambda (x) ((g g) x)))) (lambda (g) (f (lambda (x) ((g g) x))))))) ; the real Y-combinator. Just as an example -- it won't work here ; due to parser limitations (define Y (lambda (g) (lambda (x) (g (x x))) (lambda (x) (g (x x))))) ; we are getting close to a lisp like lambdas (define gt (lambda (x) (lambda (y) (((Z (lambda (rec) (lambda (x) (lambda (y) (((if (zerop x)) false) (((if (zerop y)) true) ((rec (pred x)) (pred y)))))))) x) y)))) (dispb ((gt five) three)) ; => true (newline) (dispb ((gt two) four)) ; => false (newline) ; TODO: I would like to call this function "<", but my parser sucks (define lt (lambda (x) (lambda (y) (((Z (lambda (rec) (lambda (x) (lambda (y) (((if (zerop y)) false) (((if (zerop x)) true) ((rec (pred x)) (pred y)))))))) x) y)))) (dispb ((lt five) three)) ; => false (newline) (dispb ((lt two) four)) ; => true (newline) (dispb ((lt two) two)) ; => false (newline) (define lte (lambda (x) (lambda (y) (zerop ((sub x) y))))) ; TODO: using the same method I can declare gt, gte, etc (dispb ((lte four) two)) ; => false (newline) (dispb ((lte four) four)) ; => true (newline) (dispb ((lte four) five)) ; => true (newline) ; actually, greater than must be defined as follow, since we've ; specially defined pred function in a way x-y=0, if y greater than x (define gt-alt (lambda (x) (lambda (y) (not ((lte x) y))))) (dispb ((gt-alt two) five)) ; => false (newline) (dispb ((gt-alt four) two)) ; => true (newline) (define eq (lambda (x) (lambda (y) (((Z (lambda (rec) (lambda (x) (lambda (y) (((if (zerop x)) (((if (zerop y)) true) false)) ((rec (pred x)) (pred y))))))) y) x)))) (dispb ((eq two) two)) ; => true (newline) (dispb ((eq five) two)) ; => false (newline) ;------------------------- ; Basic unit-test (define assert_eq (lambda (x) (lambda (y) (((if ((eq x) y)) (display "OK")) (display "Fail!")) (newline)))) ; Euclidean algorithm and GCD (define modulo (lambda (i) (lambda (j) (((Z (lambda (rec) (lambda (i) (lambda (j) (((if ((lt i) j)) i) ((rec ((sub i) j)) j)))))) i) j)))) (define six (succ five)) (dispn ((modulo six) four)) ; => 2 (newline) (dispn ((modulo four) six)) ; => 4 (newline) (dispn ((modulo four) four)) ; => 0 (newline) (define gcd (lambda (i) (lambda (j) (((Z (lambda (rec) (lambda (x) (lambda (y) (((if (zerop j)) i) ((gcd j) ((modulo i) j))))))) y) x)))) (dispn ((gcd four) six)) ; => 2 (newline) ;------------------------- ; Self-application and recursion (define U (lambda (f) (f f))) (define fact-nr (lambda (f) (lambda (n) (((if (zerop n)) one) ((mul n) ((f f) (pred n))))))) (dispn ((U fact-nr) four)) ; => 24 (newline) ;------------------------- ; TODO: define SKI and BCKW basis (define fact (lambda (n) ((Z (lambda (rec) (lambda (x) (((if (zerop x)) one) ((mul x) (rec (pred x))))))) n))) (dispn (fact four)) ; => 24 (newline) ; factorial iterative (define fact-iter1 ; that's an interesting function, for example, we ; can speedup this function a little by using succ ; method instead of (pred counter) (lambda (product) (lambda (counter) (((Z (lambda (rec) (lambda (product) (lambda (counter) (((if (zerop counter)) product) ((fact-iter1 ((mul counter) product)) (pred counter))))))) product) counter)))) ; factorial iterative (define fact-iter (lambda (n) ((fact-iter1 one) n))) (dispn (fact-iter four)) ; => 24 (newline) (define fib (lambda (x) ((Z (lambda (rec) (lambda (x) (((if ((lt x) three)) x) ((sum (rec (pred x))) (pred (pred x))))))) x))) (dispn (fib five)) ; => 8 (newline) ; fib iterative to test tail recursion (define fib-iter1 (lambda (a) (lambda (b) (lambda (count) ((((Z (lambda (rec) (lambda (a) (lambda (b) (lambda (count) (((if ((eq count) zero)) b) (((rec ((sum a) b)) a) (pred count)))))))) a) b) count))))) (define fib-iter (lambda (n) (((fib-iter1 one) one) n))) (dispn (fib-iter five)) ; => 8 (newline) ;------------------------- ; Ordered Pairs (define cons (lambda (p) (lambda (q) (lambda (fn) ((fn p) q))))) (define car (lambda (p) (p true))) (define cdr (lambda (p) (p false))) (dispb (car ((cons false) true))) ; => false (newline) ; finally, we can define a better predcessor function. the basic idea is ; to use pair (x, y), where second element is an incremented first ; element: (n-1, n), or (n, n+1) (define F (lambda (x) ((cons (cdr x)) (succ (cdr x))))) (define pred-p (lambda (n) (car ((n F) ((cons zero) zero))))) ;------------------------- ; Lists (define nil (lambda (x) true)) ; TODO: a better name with p end (this is a predicate), anyone? (define null (lambda (p) (p (lambda (x) (lambda (y) false))))) (dispb (null ((cons one) two))) ; => false (newline) (dispb (null nil)) ; => true (newline) (define append (lambda (x) (lambda (y) (((Z (lambda (rec) (lambda (x) (lambda (y) (((if (null x)) y) ((cons (car x)) ((rec (cdr x)) y))))))) x) y)))) (dispn (car (cdr (cdr (cdr ; TODO: define nth function ((append ((cons three) ((cons four) ((cons five) nil)))) ((cons two) ((cons one) nil)))))))) ; (cadddr (append '(3 4 5) '(2 1))) => 2 (newline) (dispn (car (cdr (cdr (cdr ((append ((cons one) ((cons two) ((cons three) nil)))) ((cons four) ((cons five) nil)))))))) ; (cadddr (append '(1 2 3) '(4 5))) => 4 (newline) (define length (lambda (x) (((Z (lambda (rec) (lambda (x) (lambda (acc) (((if (null x)) acc) ((rec (cdr x)) (succ acc))))))) x) zero))) (dispn (length ((append ((cons two) ((cons three) ((cons four) nil)))) ((cons one) nil)))) ; => 4 (newline) ;------------------------- ; Rational numbers (define make-rat (lambda (n) (lambda (d) ((cons n) d)))) (define numer (lambda (x) (car x))) (define denom (lambda (x) (cdr x))) (define add-rat (lambda (x) (lambda (y) ((make-rat ((sum ((mul (numer x)) (denom y))) ((mul (numer y)) (denom x)))) ((mul (denom x)) (denom y)))))) (define sub-rat (lambda (x) (lambda (y) ((make-rat ((sub ((mul (numer x)) (denom y))) ((mul (numer y)) (denom x)))) ((mul (denom x)) (denom y)))))) (define mul-rat (lambda (x) (lambda (y) ((make-rat ((mul (numer x)) (numer y))) ((mul (denom x)) (denom y)))))) (define div-rat (lambda (x) (lambda (y) ((make-rat ((mul (numer x)) (denom y))) ((mul (denom x)) (numer y)))))) (define equal-rat (lambda (x) (lambda (y) ((eq ((mul (numer x)) (denom y))) ((mul (numer y)) (denom x)))))) (define disp-rat (lambda (x) (dispn (numer x)) (display "/") (dispn (denom x)) (newline))) (disp-rat ((make-rat one) two)) (disp-rat ((add-rat ((make-rat one) two)) ((make-rat two) three))) ; TODO: assert-equal-rat ;------------------------- ; Higher-order functions (define map (lambda (f) (lambda (l) (((if (null l)) nil) ((cons (f (car l))) ((map f) (cdr l))))))) ; TODO: Z-combinator (define each (lambda (f) (lambda (l) (((Z (lambda (rec) (lambda (f) (lambda (l) (((if (null l)) nil) ((lambda () (f (car l)) ; Q: is it allowed at all to have ; concurent fn calls? ((rec f) (cdr l))))))))) f) l)))) (define displ (lambda (x) ((each (lambda (x) (dispn x) (display " "))) x))) (displ ((cons two) ((cons three) ((cons four) nil)))) ; => 2 3 4 (newline) (define filter (lambda (p) (lambda (l) (((Z (lambda (rec) (lambda (p) (lambda (l) (((if (null l)) nil) (((if (p (car l))) ((cons (car l)) ((rec p) (cdr l)))) ((rec p) (cdr l)))))))) p) l)))) (displ ((filter (lambda (x) ((lte x) two))) ((cons one) ((cons two) ((cons three) ((cons four) nil)))))) ; => 1 2 (newline) (define foldr (lambda (func) (lambda (end) (lambda (lst) (((if (null lst)) end) ((func (car lst)) (((foldr func) end) (cdr lst)))))))) (define foldl (lambda (func) (lambda (accum) (lambda (lst) (((if (null lst)) accum) (((foldl func) ((func accum) (car lst))) (cdr lst)))))))
In the next (imaginary) post: redefine core functions like sum, length, reverse using higher-order foldr, foldl and map functions, then as an excercise define quicksort function and get its lambda term.

playground, theneverendingstory, lambda

Previous post Next post
Up