.^add_method, .^add_multi_method, .^attributes, .^add_parent and (tod…

…o) .^add_role for parametric and concrete role meta-objects. Should mean we're just a composer away from working roles in NQP.

src/metamodel/how/NQPConcreteRoleHOW.pm

@@ -8,9 +8,13 @@ knowhow NQPConcreteRoleHOW {
     # Name of the concrete role.
     has $!name;
 
+    # What parametric role it was instantiated from.
+    has $!instance_of;
+
     # Attributes and methods.
     has %!attributes;
     has %!methods;
+    has @!multi_methods_to_incorporate;
 
     # Have we been composed?
     has $!composed;
@@ -21,23 +25,55 @@ knowhow NQPConcreteRoleHOW {
     ##
 
     # Creates a new instance of this meta-class.
-    method new(:$name!) {
+    method new(:$name!, :$instance_of!) {
         my $obj := pir::repr_instance_of__PP(self);
-        $obj.BUILD(:name($name));
+        $obj.BUILD(:name($name), :instance_of($instance_of));
         $obj
     }
 
-    method BUILD(:$name!) {
+    method BUILD(:$name!, :$instance_of!) {
         $!name := $name;
+        $!instance_of := $instance_of;
     }
 
     # Create a new meta-object instance, and then a new type object
     # to go with it, and return that.
-    method new_type(:$name = '<anon>', :$repr = 'P6opaque') {
-        my $metarole := self.new(:name($name));
+    method new_type(:$name = '<anon>', :$repr = 'P6opaque', :$instance_of!) {
+        my $metarole := self.new(:name($name), :instance_of($instance_of));
         pir::repr_type_object_for__PPS($metarole, $repr);
     }
 
+    method add_method($obj, $name, $code_obj) {
+        if %!methods{$name} {
+            pir::die("This role already has a method named " ~ $name);
+        }
+        %!methods{$name} := $code_obj;
+    }
+
+    method add_multi_method($obj, $name, $code_obj) {
+        my %todo;
+        %todo<name> := $name;
+        %todo<code> := $code_obj;
+        @!multi_methods_to_incorporate[+@!multi_methods_to_incorporate] := %todo;
+        $code_obj;
+    }
+
+    method add_attribute($obj, $meta_attr) {
+        my $name := $meta_attr.name;
+        if %!attributes{$name} {
+            pir::die("This role already has an attribute named " ~ $name);
+        }
+        %!attributes{$name} := $meta_attr;
+    }
+
+    method add_parent($obj, $parent) {
+        pir::die("A role cannot inherit from a class")
+    }
+
+    method add_role($obj, $role) {
+        pir::die("Roles doing roles is not yet implemented in NQP")
+    }
+
     # Compose the role. Beyond this point, no changes are allowed.
     method compose($obj) {
         $!composed := 1;

src/metamodel/how/NQPParametricRoleHOW.pm

@@ -13,6 +13,7 @@ knowhow NQPParametricRoleHOW {
     # Attributes and methods.
     has %!attributes;
     has %!methods;
+    has @!multi_methods_to_incorporate;
 
     # Have we been composed?
     has $!composed;
@@ -46,6 +47,37 @@ knowhow NQPParametricRoleHOW {
         pir::repr_type_object_for__PPS($metarole, $repr);
     }
 
+    method add_method($obj, $name, $code_obj) {
+        if %!methods{$name} {
+            pir::die("This role already has a method named " ~ $name);
+        }
+        %!methods{$name} := $code_obj;
+    }
+
+    method add_multi_method($obj, $name, $code_obj) {
+        my %todo;
+        %todo<name> := $name;
+        %todo<code> := $code_obj;
+        @!multi_methods_to_incorporate[+@!multi_methods_to_incorporate] := %todo;
+        $code_obj;
+    }
+
+    method add_attribute($obj, $meta_attr) {
+        my $name := $meta_attr.name;
+        if %!attributes{$name} {
+            pir::die("This role already has an attribute named " ~ $name);
+        }
+        %!attributes{$name} := $meta_attr;
+    }
+
+    method add_parent($obj, $parent) {
+        pir::die("A role cannot inherit from a class")
+    }
+
+    method add_role($obj, $role) {
+        pir::die("Roles doing roles is not yet implemented in NQP")
+    }
+
     # Compose the role. Beyond this point, no changes are allowed.
     method compose($obj) {
         $!composed := 1;
@@ -70,10 +102,23 @@ knowhow NQPParametricRoleHOW {
         $!body_block(|@pos_args, |%named_args);
 
         # Construct a new concrete role.
-        my $irole := NQPConcreteRoleHOW.new_type(:name($!name));
+        my $irole := NQPConcreteRoleHOW.new_type(:name($!name), :instance_of($obj));
+
+        # Copy attributes. (Nothing to reify in NQP as we don't currently
+        # have parametric types that may end up in the signature.)
+        for %!attributes {
+            $irole.HOW.add_attribute($irole, $_.value);
+        }
+
+        # Capture methods in the correct lexical context. Don't need to
+        # do any signature reification in NQP; no type parameters.
+        for %!methods {
+            $irole.HOW.add_method($irole, $_.key, pir::clone($_.value));
+        }
+        for @!multi_methods_to_incorporate {
+            $irole.HOW.add_multi_method($irole, $_<name>, pir::clone($_<code>));
+        }
 
-        # XXX Much comes here
-
         # Compose and return produced role.
         $irole.HOW.compose($irole);
         return $irole;