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.