Implement nextsame and callsame.

src/Perl6/Metamodel/Dispatchers.pm

@@ -6,7 +6,7 @@ class Perl6::Metamodel::BaseDispatcher {
 
     method last()      { @!candidates := [] }
 
-    method call_next(*@pos, *%named) {
+    method call_with_args(*@pos, *%named) {
         my $call := @!candidates[$!idx];
         $!idx := $!idx + 1;
         if self.has_invocant {
@@ -19,6 +19,26 @@ class Perl6::Metamodel::BaseDispatcher {
             $call(|@pos, |%named);
         }
     }
+
+    method call_with_capture($capture) {
+        # Extract parts of the capture.
+        my @pos;
+        my %named;
+        my $i := 0;
+        while $i < nqp::elems($capture) {
+            @pos[$i] := $capture[$i];
+            $i := $i + 1;
+        }
+        for pir::getattribute__PPs($capture, 'named') {
+            %named{$_} := $capture{$_};
+        }
+
+        # Call.
+        my $call := @!candidates[$!idx];
+        $!idx := $!idx + 1;
+        pir::perl6_set_dispatcher_for_callee__vP(self);
+        $call(|@pos, |%named);
+    }
 }
 
 class Perl6::Metamodel::MethodDispatcher is Perl6::Metamodel::BaseDispatcher {

src/core/NYI.pm

@@ -1,6 +1,3 @@
 # things that are known to be NYI
 
 sub NYI(*@msg) { die @msg };
-
-sub callsame(|$) { NYI "callsame not yet implemented" };
-sub nextsame(|$) { NYI "nextsame not yet implemented" };

src/core/control.pm

@@ -70,13 +70,32 @@ my &proceed := -> {
 my &callwith := -> *@pos, *%named {
     my Mu $dispatcher := pir::perl6_find_dispatcher__P();
     $dispatcher.exhausted ?? Nil !!
-        $dispatcher.call_next(|@pos, |%named)
+        $dispatcher.call_with_args(|@pos, |%named)
 };
 
 my &nextwith := -> *@pos, *%named {
     my Mu $dispatcher := pir::perl6_find_dispatcher__P();
     my $parcel := $dispatcher.exhausted ?? Nil !!
-        $dispatcher.call_next(|@pos, |%named);
+        $dispatcher.call_with_args(|@pos, |%named);
+    my Mu $return := pir::find_caller_lex__Ps('RETURN');
+    nqp::isnull($return)
+        ?? die "Attempt to return outside of any Routine"
+        !! $return(pir::perl6_decontainerize__PP($parcel));
+    $parcel
+};
+
+my &callsame := -> {
+    my Mu $dispatcher := pir::perl6_find_dispatcher__P();
+    $dispatcher.exhausted ?? Nil !!
+        $dispatcher.call_with_capture(
+            pir::perl6_args_for_dispatcher__PP($dispatcher))
+};
+
+my &nextsame := -> {
+    my Mu $dispatcher := pir::perl6_find_dispatcher__P();
+    my $parcel := $dispatcher.exhausted ?? Nil !!
+        $dispatcher.call_with_capture(
+            pir::perl6_args_for_dispatcher__PP($dispatcher));
     my Mu $return := pir::find_caller_lex__Ps('RETURN');
     nqp::isnull($return)
         ?? die "Attempt to return outside of any Routine"

src/ops/perl6.ops

@@ -836,6 +836,39 @@ inline op perl6_find_dispatcher(out PMC) :base_core {
 
 /*
 
+=item perl6_args_for_dispatcher(out PMC, in PMC)
+
+Locates the callframe with the $*DISPATCHER passed and returns it.
+
+=cut
+
+*/
+inline op perl6_args_for_dispatcher(out PMC, in PMC) :base_core {
+    PMC     *ctx            = CURRENT_CONTEXT(interp);
+    STRING  *dispatcher_str = Parrot_str_new_constant(interp, "$*DISPATCHER");
+    PMC     *result         = NULL;
+
+    while (!PMC_IS_NULL(ctx)) {
+        /* Do we have a dispatcher here? */
+        PMC *lexpad = Parrot_pcc_get_lex_pad(interp, ctx);
+        if (!PMC_IS_NULL(lexpad) && VTABLE_exists_keyed_str(interp, lexpad, dispatcher_str)) {
+            PMC *dispatcher = VTABLE_get_pmc_keyed_str(interp, lexpad, dispatcher_str);
+            if (dispatcher == $2) {
+                result = ctx;
+                break;
+            }
+        }
+        ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
+    }
+
+    if (!result)
+        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+            "Could not find arguments for dispatcher");
+    $1 = result;
+}
+
+/*
+
 =item perl6_current_args_rpa(out PMC)
 
 Gets a ResizablePMCArray containing the positional arguments passed to the