Make implementing a method postcircumfix:<( )> work so you can make a…

…n object invokable. This bumps required Parrot version.

build/PARROT_REVISION

@@ -1 +1 @@
-40294
+40428

src/builtins/guts.pir

@@ -615,6 +615,10 @@ and creating the protoobjects.
     goto roles_it_loop
   roles_it_loop_end:
 
+    # We may need to set up invoke vtable if postcircumfix:<( )>
+    # is implemented.
+    '!setup_invoke_vtable'(metaclass)
+
     # Create proto-object with default parent being Any or Grammar, unless
     # there already is a parent.
     .local pmc proto
@@ -639,6 +643,34 @@ and creating the protoobjects.
 .end
 
 
+=item !setup_invoke_vtable
+
+If we override postcircumfix:<( )> then also add a
+vtable override for invoke.
+
+=cut
+
+.sub '!setup_invoke_vtable'
+    .param pmc metaclass
+    .local pmc parrotclass
+    parrotclass = getattribute metaclass, 'parrotclass'
+    $P0 = parrotclass.'methods'()
+    $P0 = $P0['postcircumfix:( )']
+    if null $P0 goto no_invoke
+    .const 'Sub' $P1 = '!invoke_vtable_override_helper'
+    parrotclass.'add_vtable_override'('invoke', $P1)
+  no_invoke:
+.end
+.sub '' :subid('!invoke_vtable_override_helper')
+    .param pmc pos_args    :slurpy
+    .param pmc named_args  :slurpy :named
+    $P0 = getinterp
+    $P0 = $P0['sub']
+    $P0 = getprop '$!self', $P0
+    .tailcall $P0.'postcircumfix:( )'(pos_args :flat, named_args :flat :named)
+.end
+
+
 =item !get_flattened_roles_list
 
 Flattens out the list of roles.

src/parser/actions.pm

@@ -1649,6 +1649,9 @@ method package_def($/, $key) {
     elsif !$block<isalso> {
         $block[0].push( PAST::Op.new( :name('!meta_compose'), $?METACLASS) );
     }
+    else {
+        $block[0].push( PAST::Op.new( :name('!setup_invoke_vtable'), $?METACLASS) );
+    }
 
     make $block;
 }
@@ -3205,7 +3208,7 @@ sub make_sigparam($var) {
 sub add_optoken($block, $match) {
     my $category := ~$match<category>;
     my $name := $category ~ ':' ~ ~$match[0];
-    if $category ne 'trait_mod' {
+    if $category ne 'trait_mod' && $name ne 'postcircumfix:( )' {
         my $equiv := 'infix:+';
         if $category eq 'prefix' { $equiv := 'prefix:+' }
         elsif $category eq 'postfix' { $equiv := 'postfix:++' }

src/pmc/p6opaque.pmc

@@ -18,6 +18,7 @@ end up containing various object behaviors that are specific to Perl 6.
 */
 
 #include "parrot/parrot.h"
+#include "parrot/oo.h"
 #include "parrot/oo_private.h"
 #include "pmc_class.h"
 #include "pmc_object.h"
@@ -316,4 +317,50 @@ back some kind of iterator to let us get all of the possible candidates.
 
         return method;
     }
+
+/*
+
+=item C<opcode_t *invoke(void *next)>
+
+Invokes the object (if this vtable function is overridden).
+
+=cut
+
+*/
+    opcode_t * invoke(void *next) {
+        Parrot_Object_attributes * const obj    = PARROT_OBJECT(pmc);
+        Parrot_Class_attributes  * const _class = PARROT_CLASS(obj->_class);
+
+        /* Walk and search for the vtable method. */
+        const int num_classes = VTABLE_elements(interp, _class->all_parents);
+        int i;
+
+        for (i = 0; i < num_classes; i++) {
+            /* Get the class. */
+            STRING * const meth_name = CONST_STRING(interp, "invoke");
+            STRING * const proxy     = CONST_STRING(interp, "proxy");
+            PMC * const cur_class =
+                VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
+
+            PMC * meth =
+                Parrot_oo_find_vtable_override_for_class(interp, cur_class,
+                                                         meth_name);
+            if (!PMC_IS_NULL(meth)) {
+                meth = VTABLE_clone(interp, meth);
+                VTABLE_setprop(interp, meth, CONST_STRING(interp, "$!self"), SELF);
+                return VTABLE_invoke(interp, meth, next);
+            }
+
+            if (cur_class->vtable->base_type == enum_class_PMCProxy) {
+                /* Get the PMC instance and call the vtable method on that. */
+                PMC * const del_object =
+                    VTABLE_get_attr_keyed(interp, pmc, cur_class, proxy);
+
+                if (!PMC_IS_NULL(del_object))
+                    return VTABLE_invoke(interp, del_object, next);
+            }
+        }
+
+        return (opcode_t *)interp->vtables[enum_class_default]->invoke(interp, pmc, next);
+    }
 }