Subclassing PAST::Node in NQP

One of the problems with NQP is that it's not quite perl6. And that means if you do much development, you eventually run up against a corner of the language where the sidewalk just ends.

The support for objects is an example of this. There's no problem with defining methods, or defining a class name. There's no problem with creating a new instance of the class. But that's where it stops being easy. Because the syntax for extending another class is missing.

One thing I'd like to do is subclass the PAST::Node class(es) in my own code, so I can use method invocations to call functions in a different namespace. This would change code like:

close::Compiler::Type::merge_specifiers($node1, $node2)

into something like:

$node1.merge($node2);

which would make my fingers happy, if nothing else.

Automatically generated, but wrong
One problem is that when I declare a class in NQP, like:

class close::Compiler::Type;

NQP emits an initload block that creates a new class. The problem is that it creates the class with no parent. Whoops. So the first thing to do is to change from using a 'class' keyword to using 'module.'
Now I won't have any class definition at all, which is actually good. All I need now is to make my own initload that creates the class.

Make your own initload sub
The trick to rolling your own initload sub is not to do it -- you can't get there from here in NQP. What you can do, though, is take advantage of the fact that any code that is at package scope in your NQP source code is put into the initload sub for the class or module you are defining.

So, since package scope is an initload sub, my solution is to define a sub and call it from package scope:

  _onload();

  sub _onload() {
    say("Hello, from _onload");
  }

Creating a class, the right way
Now that we know how to get a class created, it's time to dig into the PCT source code to see how it creates the classes. I looked in $parrot/compilers/pct/src/PAST/Node.pir, and found this:

    p6meta = new 'P6metaclass'
    base = p6meta.'new_class'('PAST::Node', 'parent'=>'PCT::Node')
    p6meta.'new_class'('PAST::Op', 'parent'=>base)

Well, that looks pretty simple! Let's convert that to NQP:

module PAST::Subclass {
   _onload();

   sub _onload() {
      my $meta := Q:PIR { %r = new 'P6metaclass' };
      $meta.new_class('PAST::Subclass', :parent('PAST::Node'));
   }
}

Note that I chose to inherit from PAST::Node, rather than PCT::Node. Once you know the trick, you can subclass just about anything.

The init problem
The next problem is that the P6metaclass system generates a really dumb 'new' method. So the easiest thing is to replace it. But if I replace it, how will I initialize the superclass data?

This is where you have to investigate on your own. In this case, I chose to inherit the PAST::Node version of 'new,' because it calls self.init(...), which I could override.

So I have an init method, but I need to call the PAST::Node::init method as well. That wouldn't be a problem, except that (1) there is no PAST::Node init method, it is inherited from PCT::Node; and (2) the PCT::Node init method wants its parameters flattened. It's more PIR code to the rescue, because NQP doesn't support flattening args:

sub init(*@children, *%attributes) {
    # do my own stuff ...
    # ... then call
     Q:PIR {
        .local pmc children, attributes
        children = find_lex '@children'
        attributes = find_lex '%attributes'
        $P0 = get_hll_global [ 'PCT' ; 'Node' ], 'init'
        self.$P0(children :flat, attributes :named :flat)       
    };

    return self;
}

And now I've got a subclass. Just to bundle it into one big copy/pasteable bunch, here you go:

module PAST::Subclass {
    _onload();

   sub _onload() {
      my $meta := Q:PIR { %r = new 'P6metaclass' };
      $meta.new_class('PAST::Subclass', :parent('PAST::Node'));
   }

   sub init(*@children, *%attributes) {
      # do my own stuff ...
      # ... then call
      Q:PIR {
         .local pmc children, attributes
         children = find_lex '@children'
         attributes = find_lex '%attributes'
         $P0 = get_hll_global [ 'PCT' ; 'Node' ], 'init'
         self.$P0(children :flat, attributes :named :flat)
      };

      return self;
   }

}