Blog Closed

This blog has moved to Github. This page will not be updated and is not open for comments. Please go to the new site for updated content.

Tuesday, September 15, 2009

Y Combinator in Pure PIR

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

2 comments:

  1. 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?

    ReplyDelete
  2. 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.

    ReplyDelete

Note: Only a member of this blog may post a comment.