## Y Combinator in Pure PIR

15 Sep 2009Tonight I took the time to do something I've wanted to do for a while: Write a Y-combinator routine in pure PIR code. I was inspired by Aristotle's excellent blog post about the topic, and the ensuing comments from his readers. I'll direct people to him for more information about the function and it's derivation.

So, without further adieu, here is the Y combinator, defined in terms of the U combinator:

# U-Combinator

.sub 'U'

.param pmc f

.lex '$f', f

.const 'Sub' U_inner = '_U_inner'

$P0 = newclosure U_inner

.return($P0)

.end

.sub '_U_inner' :outer('U')

.param pmc args :slurpy

$P0 = find_lex '$f'

$P1 = $P0($P0, args :flat)

.return($P1)

.end

# Y-Combinator, defined in terms of the U-Combinator

.sub 'Y'

.param pmc f

.lex '$f', f

.const 'Sub' Y_inner_1 = '_Y_inner_1'

$P0 = 'U'(Y_inner_1)

$P1 = $P0()

.return($P1)

.end

.sub '_Y_inner_1' :outer('Y')

.param pmc h

.lex '$h', h

.const 'Sub' Y_inner_2 = '_Y_inner_2'

$P0 = newclosure Y_inner_2

.return($P0)

.end

.sub '_Y_inner_2' :outer('_Y_inner_1')

.param pmc args :slurpy

.local pmc f

.local pmc h

f = find_lex '$f'

h = find_lex '$h'

$P0 = 'U'(h)

$P1 = $P0()

$P2 = f($P1)

$P3 = $P2(args)

.return($P3)

.end

And here is a little driver program that uses it to calculate the factorial of 10:

.sub 'main' :main

.const 'Sub' wrapper = 'fact_wrapper'

.local pmc x

x = box 10

$P0 = 'Y'(wrapper)

$P1 = $P0(x)

print "Answer: "

say $P1

.end

.sub 'fact_wrapper'

.param pmc f

.lex '$f', f

.const 'Sub' fact = 'factorial'

$P0 = newclosure fact

.return($P0)

.end

.sub 'factorial' :outer('fact_wrapper')

.param pmc whatev

.local pmc n

n = shift whatev

print "Calculating factorial of "

say n

if n >= 2 goto n_is_large

.return(1)

n_is_large:

.local pmc f

f = find_lex '$f'

.local pmc n_minus_one

n_minus_one = n - 1

$P0 = f(n_minus_one)

$P1 = $P0 * n

.return($P1)

.end

It was quite a fun little exercise, and a great workout for the newclosure opcode, which I'm not sure is well-tested elsewhere. I may add this, or something like it, to the test suite for Parrot to run.

This entry was originally posted on Blogger and was automatically converted. There may be some broken links and other errors due to the conversion. Please let me know about any serious problems.

## Comments

Andrew,

Does this work?

I was reading through the code, and I notice that Y does not enclose Y-1. (Unless the .const does that implicitly, which I don't think it does.)

So I guess it's (a) does Y need to enclose Y-1, or need to not do so; and (b) have you tested this code?

This code does indeed work. I was quite surprised by it, but Parrot handles this complicated situation quite handily.

Y does not enclose Y-1. It encloses _Y_inner_1, which in turn encloses _Y_inner_2. I don't really understand how all of it works, but I have verified that the result of my little test is correct. I would love to put it through some more rigorous testing though.