"The Y of Why" in newLISP
The task is to find a function Y, which can transform a recursive function into a function which is truly functional without side effects, no free variables and a fixed point property. The following is a version of Richard P. Gabriel's "The Why of Y" [1] modified for newLISP.
Find Y
This is the original recursive definition for factorial fact:
(define fact (lambda (n) (if (< n 2) 1 (* n (fact (- n 1))))))
The original factorial redefined as an anonymous function and taking the true factorial in h:
(lambda (h) (lambda (n) (if (< n 2) 1 (* n (h (- n 1))))))
If this function is called F and the true factorial is f then ((F f) n) = (F n), f is a fixed point of F.
We are looking for a function Y with the property: ((F (Y F)) x) = ((Y F) x)
This function is called the Applicative-order Y fixed point operator for functionals. To achieve this we transform the basic form of the factorial function:
The basic factorial with h the true factorial:
(lambda (n) (if (< n 2) 1 (* n (h (- n 1)))))
Pass h the factorial function as parameter:
(lambda (h n) (if (< n 2) 1 (* n (h h (- n 1)))))
Package as anonymous expression and try it out:
(let ((g (lambda (h n)
(if (< n 2) 1 (* n (h h (- n 1)))))))
(g g 10)) ;=> 3628800
Up to this point expressions are identical to those found in Richard P. Gabriel's "The Why of Y". The rest of the transformations follows Gabriel's, but inserts the newLISP function expand where required to achieve a closure effect for the function passed as a parameter into the (lambda (h) ...) expression.
Curry (g g 10) to ((g g) 10) :
(let ((g (lambda (h)
(expand (lambda (n) (if (< n 2) 1 (* n ((h h) (- n 1))))) 'h))))
((g g) 10))
Abstract the (h h) out as f :
(let ((g (lambda (h)
(expand (lambda (n)
(let ((f (lambda (f n)
(if (< n 2) 1 (* n (f (- n 1)))))))
(f (h h) n))) 'h))))
((g g) 10))
Curry definition of f for f in (lambda (f n) ...) :
(let ((g (lambda (h)
(expand (lambda (n)
(let ((f (lambda (q)
(expand (lambda (n)
(if (< n 2) 1 (* n (q (- n 1))))) 'q) ))) ; in Scheme
((f (h h)) n))) 'h))))
((g g) 10))
Refactor to bring f to the top:
(let ((f (lambda (q) (expand (lambda (n) (if (< n 2) 1 (* n (q (- n 1))))) 'q))))
(let ((g (lambda (h) (expand (lambda (n) ((f (h h)) n)) 'h))))
((g g) 10)))
The Y function
Now define Y as doing the correct expansion and substitution of h and f :
(define Y (lambda (f) (expand
(let ((g (lambda (h) (expand (lambda (x) ((f (h h)) x)) 'h))))
(g g)) 'f)))
Avoiding the let and writing out the (g g) expression yields:
(define Y (lambda (f) (expand
((lambda (h) (expand (lambda (x) ((f (h h)) x)) 'h))
(lambda (h) (expand (lambda (x) ((f (h h)) x)) 'h))) 'f)) )
newLISP needs to expand to get closure effect for the passed procedure q :
(define f
(lambda (q) (expand (lambda (n) (if (< n 2) 1 (* n (q (- n 1))))) 'q)))
((Y f) 10) ;=> 3628800
Show the fixed point property:
(= ((Y f) 10) ((f (Y f)) 10) ) ;=> true
((f (Y f)) 10) ;=> 3628800
((f (f (Y f))) 10) ;=> 3628800
The return value of (Y f) shows that (Y f) is pure functional, without any side effects and no free variables:
(lambda (x)
(((lambda (q) (expand (lambda (n) (if (< n 2) 1 (* n (q (- n 1))))) 'q))
((lambda (h) (expand (lambda (x) (((lambda (q) (expand
(lambda (n) (if (< n 2) 1 (* n (q (- n 1))))) 'q)) (h h)) x)) 'h))
(lambda (h) (expand (lambda (x) (((lambda (q) (expand
(lambda (n) (if (< n 2) 1 (* n (q (- n 1))))) 'q)) (h h)) x)) 'h)))) x))
Check another recursive function fibo :
(define f (lambda (q) (expand
(lambda(n) (if(< n 2) 1 (+ (q (- n 1)) (q (- n 2))))) 'q)) )
(define fibo (Y f))
(fibo 10) ;=> 89
[1] The Why of Y
Richard P. Gabriel - 2001
http://www.dreamsongs.com/NewFiles/WhyOfY.pdf
Notes
Lambda calculus in newLISP based on redefinition of Lambda - expand expands uppercase variables - :(define-macro (LAMBDA)
(append (lambda ) (expand (args))))
See Mike Vanier's site for a slightly different version of Y but with identical functionally.
A derivation of the Y-Combinator in JavaScript: Deriving the Y Combinator in 7 Easy Steps (added 2010-12-05)