Where Wizards Fear To Tread
by Simon Cozens |

Fixing It Up With B::Generate

B::Generate was written to allow users to create their own ops and insert them into the op tree. The original intent was to be able to create bytecode for other languages to be run on the Perl virtual machine, but it's found plenty of use manipulating existing Perl op trees.

It provides ``constructor'' methods in all of the B::*OP classes, and makes many of the accessor methods read-write instead of read-only. Let's see how we can apply it to this problem. Remember that we want to negate the sense of the test, and then to add another argument to the call to don't.

For the first of these tasks, B::Generate provides the handy mutate and convert methods on each B::OP-derived object to change one op's type into another. The decision as to which of them use is slightly complex: mutate can only be used for ops of the same type - for instance, you cannot use it to mutate a binary op into a unary op. However, convert produces a completely new op, which needs to be threaded back into the op tree. So convert is much more powerful, but mutate is much more convenient. In this case, since we're just flipping between and and or, we can get away with using mutate:

    require B::Generate;

    my $op = shift;

    if ($op->name eq "and") {

        $op->mutate("or");

    } else {

        $op->mutate("and");

    }

Now to insert the additional parameter. For this, remember that entersub works by popping off the top entry in the stack and calling that as a subroutine, and the remaining stack entries become parameters to the subroutine. So we want to add a const op to put a constant on the stack. We use the B::SVOP->new constructor to create a new one, and then thread the next pointers so that Perl's main loop will call it between $op->other->sibling (the refgen op) and the op after it. (the GV which represents *don::t)

    my $to_insert = $op->other->sibling;

    my $newop = B::SVOP->new("const", 0, 1);

    $newop->next($to_insert->next);

    $to_insert->next($newop);

All that's left is to replace the definition of don't so that, depending on the parameters, it sometimes does:

    sub don't (&;$) { $_[0]->() if $_[1] }

And there we have it:

    package Acme::Don't;

    CHECK {

        use B::Utils qw(opgrep walkallops_filtered);

        walkallops_filtered(

            sub {

                my $op = shift;

                opgrep(

                {

                    name => ["and", "or"],

                    other => {

                        name => "pushmark",

                        sibling => { next => { name => "gv" }}

                    }

                }, $op) or return;

                my $gv = $op->other->sibling->next->gv;

                return unless $gv->STASH->NAME eq "don" and $gv->NAME eq "t";

                return 1;

            },

            sub {

                require B::Generate;

                my $op = shift;

                if ($op->name eq "and") {

                    $op->mutate("or");

                } else {

                    $op->mutate("and");

                }

                

                my $to_insert = $op->other->sibling;

                my $newop = B::SVOP->new("const", 0, 1);

                $newop->next($to_insert->next);

                $to_insert->next($newop);

            }

       );

    }

    

    sub don't (&;$) { $_[0]->() if $_[1] }

This will turn

    $false = 0; $true = 1;

    

    don't { print "Testing" } if $false;

    don't { print "Testing again" } unless $true;

into

    $false = 0; $true = 1;

    

    don't(sub { print "Testing" }, 1) unless $false;

    don't(sub { print "Testing again" }, 1) if $true;

setting off the conditions and making don't do the code. A neat trick? We think so.

Where To From Here?

But that's not all! And, of course, this doesn't cater for some of the more complex constructions people can create, such as

    if ($x) {

        do_something();

        don't { do_the_other_thing() };

        do_something_else();

    }

or even

    if ($x) {

        do_that();

        don't { do_this() }

    } else {

        do_the_other();

        don't { do_something_else() }

    }

But this can be solved in just the same way. For instance, you want to turn the first one into

    if ($x) {

        do_something();

        do_something_else();

    } else {

        don't(sub { do_the_other_thing() }, 1);

    }

and the second into

    if ($x) {

        do_that();

        don't(sub { do_something_else() }, 1);

    } else {

        do_the_other();

        don't(sub { do_this() }, 1);

    }

Both of these transformations can be done by applying the method above: compare the op trees, work out the difference, find the pattern you want to look for, then write some code to manipulate the op tree into the desired output. An easy task for the interested reader ...

And we really haven't scratched the surface of what can be done with B::Generate and B::Utils; the B::Generate test suite shows what sort of mayhem can be caused to existing Perl programs, and there have been experiments using B::Generate to generate op trees for other languages - a B::Generate port of Leon Brocard's shiny Ruby interpreter could produce Perl bytecode for simple Ruby programs; chromatic is working on an idea to turn Perl programs into XML, manipulate them and use B::Generate to turn them back into Perl op trees.

Later in our ``Where Wizards Fear To Tread'' series, we'll have articles about Perl and Java interaction, iThreads, and more.

Prev  [1] [2]