Apply patch from Richard Hainsworth to add Parrot vtable delegation.

Author: jnthn

src/6model/sixmodelobject.h

@@ -14,6 +14,11 @@ typedef struct {
     PMC *sc;      /* Serialization context. */
 } SixModelObjectCommonalities;
 
+typedef struct {
+    PMC *class_handle;  /* Class handle */
+    STRING *att_name;      /* Name of the attribute. */
+} ParrotVtableHandlerSlot;
+
 /* S-Tables (short for Shared Table) contains the commonalities shared between
  * a (HOW, REPR) pairing (for example, (HOW for the class Dog, P6Opaque). */
 typedef struct {
@@ -61,6 +66,11 @@ typedef struct {
     /* Parrot-specific set of v-table to method mappings, for overriding
      * of Parrot v-table functions. */
     PMC **parrot_vtable_mapping;
+
+	/**
+	 * Parrot-specific set of v-table to object method mappings */
+	ParrotVtableHandlerSlot *parrot_vtable_handler_mapping;
+
 } STable;
 
 /* A representation is what controls the layout of an object and storage of

src/NQP/Actions.pm

@@ -661,7 +661,14 @@ class NQP::Actions is HLL::Actions {
             ));
             $BLOCK.symbol($name, :scope('lexical') );
         }
+
+        # Apply traits.
         make $past;
+
+        if $<trait> {
+            for $<trait> { $_.ast()($/); }
+        }
+
     }
 
     method routine_declarator:sym<sub>($/) { make $<routine_def>.ast; }
@@ -983,6 +990,17 @@ class NQP::Actions is HLL::Actions {
                     $match.ast<block_past>, $is_dispatcher);
             };
         }
+        elsif $<longname> eq 'parrot_vtable_handler' {
+            # XXX This should be in Parrot-specific module and need a pragma.
+            my $cpast := $<circumfix>[0].ast;
+            $/.CURSOR.panic("Trait 'parrot_vtable_handler' requires constant scalar argument")
+                unless $cpast ~~ PAST::Val;
+            my $name := $cpast.value;
+            my $package := $*PACKAGE;
+            make -> $match {
+                $*SC.pkg_add_parrot_vtable_handler_mapping($package, $name, ~$match<variable>);
+            };
+        }
         elsif $<longname> eq 'pirflags' {
             $/.CURSOR.panic("Trait 'pirflags' no longer supported; use 'is vtable'");
         }

src/NQP/Grammar.pm

@@ -404,6 +404,7 @@ grammar NQP::Grammar is HLL::Grammar {
         :my $*IN_DECL := 'variable';
         <variable>
         { $*IN_DECL := 0; }
+        <trait>*
     }
 
     proto token routine_declarator { <...> }

src/NQP/SymbolTable.pm

@@ -363,7 +363,21 @@ class NQP::SymbolTable is HLL::Compiler::SerializationContextBuilder {
             self.get_object_sc_ref_past($to_add)
         )));
     }
-    
+
+    method pkg_add_parrot_vtable_handler_mapping($obj, $name, $att_name) {
+        # Do the actual addition on the meta-object immediately.
+        $obj.HOW.add_parrot_vtable_handler_mapping($obj, $name, $att_name);
+
+        # Emit code to add it when deserializing.
+        my $slot_past := self.get_slot_past_for_object($obj);
+        self.add_event(:deserialize_past(PAST::Op.new(
+            :pasttype('callmethod'), :name('add_parrot_vtable_handler_mapping'),
+            PAST::Op.new( :pirop('get_how PP'), $slot_past ),
+            $slot_past,
+			$name, $att_name
+        )));
+    }
+
     # Composes the package, and stores an event for this action.
     method pkg_compose($obj) {
         # Compose.

src/how/NQPClassHOW.pm

@@ -33,7 +33,7 @@ knowhow NQPClassHOW {
 
     # Parrot-specific vtable mapping hash. Maps vtable name to method.
     has %!parrot_vtable_mapping;
-
+	has %!parrot_vtable_handler_mapping;
     ##
     ## Declarative.
     ##
@@ -126,6 +126,15 @@ knowhow NQPClassHOW {
         %!parrot_vtable_mapping{$name} := $meth;
     }
 
+    method add_parrot_vtable_handler_mapping($obj, $name, $att_name) {
+        if pir::defined(%!parrot_vtable_handler_mapping{$name}) {
+            pir::die("Class '" ~ $!name ~
+                "' already has a Parrot v-table handler for '" ~
+                $name ~ "'");
+        }
+        %!parrot_vtable_handler_mapping{$name} := [ $obj, $att_name ];
+    }
+
     method compose($obj) {
         # Incorporate roles. First, instantiate them with the type object
         # for this type (so their $?CLASS is correct). Then delegate to
@@ -166,6 +175,7 @@ knowhow NQPClassHOW {
 
         # Install Parrot v-table mapping.
         self.publish_parrot_vtable_mapping($obj);
+		self.publish_parrot_vtablee_handler_mapping($obj);
 
         $obj
     }
@@ -354,6 +364,20 @@ knowhow NQPClassHOW {
         }
     }
 
+    method publish_parrot_vtablee_handler_mapping($obj) {
+        my %mapping;
+        for @!mro {
+            my %map := $_.HOW.parrot_vtable_handler_mappings($_, :local(1));
+            for %map {
+                unless %mapping{$_.key} {
+                    %mapping{$_.key} := $_.value;
+                }
+            }
+        }
+        if +%mapping {
+            pir::stable_publish_vtable_handler_mapping__vPP($obj, %mapping);
+        }
+    }
     ##
     ## Introspecty
     ##
@@ -394,6 +418,10 @@ knowhow NQPClassHOW {
         %!parrot_vtable_mapping
     }
 
+    method parrot_vtable_handler_mappings($obj, :$local!) {
+        %!parrot_vtable_handler_mapping
+    }
+
     ##
     ## Checky
     ##

src/ops/nqp.ops

@@ -725,6 +725,57 @@ inline op stable_publish_vtable_mapping(in PMC, in PMC) :base_core {
             "Can only use stable_publish_vtable_mapping with a SixModelObject");
 }
 
+/*
+=item publish_vtable_handler_mapping()
+
+Publishes a Parrot v-table handler mapping, which will be hung off the s-table.
+It's stored as an array, so lookups will be speedy.
+
+=cut
+
+*/
+inline op stable_publish_vtable_handler_mapping(in PMC, in PMC) :base_core {
+    if ($1->vtable->base_type == smo_id) {
+        INTVAL i;
+
+        /* Get s-table and iterator over the mapping. */
+        STable *st = STABLE($1);
+        PMC    *it = VTABLE_get_iter(interp, $2);
+
+        /* Toss any exist mapping array; allocate new one. */
+        if (st->parrot_vtable_handler_mapping)
+            mem_sys_free(st->parrot_vtable_handler_mapping);
+        st->parrot_vtable_handler_mapping = mem_allocate_n_zeroed_typed(NUM_VTABLE_FUNCTIONS + PARROT_VTABLE_LOW, ParrotVtableHandlerSlot);
+
+        /* Go through the various mapped names and insert them into the
+         * mapping table. */
+        while (VTABLE_get_bool(interp, it)) {
+            STRING *name   = VTABLE_shift_string(interp, it);
+            char   *c_name = Parrot_str_to_cstring(interp, name);
+            PMC    *slot   = VTABLE_get_pmc_keyed_str(interp, $2, name);
+            INTVAL  idx    = -1;
+            for (i = PARROT_VTABLE_LOW; i < NUM_VTABLE_FUNCTIONS + PARROT_VTABLE_LOW; i++) {
+                if (strcmp(Parrot_vtable_slot_names[i], c_name) == 0) {
+                    idx = i;
+                    break;
+                }
+            }
+            if (idx >= 0) {
+                st->parrot_vtable_handler_mapping[idx].class_handle = VTABLE_get_pmc_keyed_int(interp,slot,0);
+                st->parrot_vtable_handler_mapping[idx].att_name = VTABLE_get_string_keyed_int(interp,slot,1);
+            }
+			else
+                Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+                    "No such Parrot v-table '%Ss'", name);
+        }
+
+        PARROT_GC_WRITE_BARRIER(interp, STABLE_PMC($1));
+    }
+    else
+        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+            "Can only use stable_publish_vtable_handler_mapping with a SixModelObject");
+}
+
 /*
 
 =item nqp_get_sc_object()