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.

Andrew,

ReplyDeleteDoes 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.

ReplyDeleteY 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.