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.