Add nextdispatcherfor/takenextdispatcher ops

Provide support for Raku chained dispatchers. Their purpose is to pass
information to the downstream dispatcher about what upstream dispatcher
must take over the control next when downstream exhausts.

For example, when one wraps a candidate in a multi, the `WrapDispatcher`
must know about the instance of `MultiDispatcher` to switch back to it
when all wrappers are done and the candidate calls one of
`{next|call}{same|with}`.

Technically, both ops are clones for `setdispatcherfor`/`takedispatcher`
except that they operate with `next_dispatcher` and
`next_dispatcher_for` members of `ThreadContext`; and their purpose
differs too.

Requires MoarVM/MoarVM#1252.

Author: vrurg

src/NQP/Optimizer.nqp

@@ -170,7 +170,8 @@ class NQP::Optimizer {
     my %opt_n_i := nqp::hash('add', 1, 'sub', 1, 'mul', 1, 'mod', 1, 'neg', 1, 'abs', 1, 'iseq', 1, 'isne', 1,
                              'islt', 1, 'isle', 1, 'isgt', 1, 'isge', 1, 'cmp', 1);
 
-    my %op_poisons_lowering := nqp::hash('ctx', 1, 'curlexpad', 1, 'takedispatcher', 1, 'getlexouter', 1);
+    my %op_poisons_lowering := nqp::hash('ctx', 1, 'curlexpad', 1, 'takedispatcher', 1, 'takenextdispatcher', 1,
+                                         'getlexouter', 1);
 
     method visit_op($op) {
         # Handle op needs special handling.

src/vm/moar/QAST/QASTOperationsMAST.nqp

@@ -3018,6 +3018,7 @@ QAST::MASTOperations.add_core_moarop_mapping('setcodename', 'setcodename', 0);
 QAST::MASTOperations.add_core_moarop_mapping('forceouterctx', 'forceouterctx', 0);
 QAST::MASTOperations.add_core_moarop_mapping('setdispatcher', 'setdispatcher', 0);
 QAST::MASTOperations.add_core_moarop_mapping('setdispatcherfor', 'setdispatcherfor', 0);
+QAST::MASTOperations.add_core_moarop_mapping('nextdispatcherfor', 'nextdispatcherfor', 0);
 QAST::MASTOperations.add_core_op('takedispatcher', -> $qastcomp, $op {
     my $regalloc := $*REGALLOC;
     unless nqp::istype($op[0], QAST::SVal) {
@@ -3038,7 +3039,28 @@ QAST::MASTOperations.add_core_op('takedispatcher', -> $qastcomp, $op {
     $regalloc.release_register($isnull_reg, $MVM_reg_int64);
     MAST::InstructionList.new(MAST::VOID, $MVM_reg_void)
 });
+QAST::MASTOperations.add_core_op('takenextdispatcher', -> $qastcomp, $op {
+    my $regalloc := $*REGALLOC;
+    unless nqp::istype($op[0], QAST::SVal) {
+        nqp::die("The 'takenextdispatcher' op must have a single QAST::SVal child, got " ~ $op[0].HOW.name($op[0]));
+    }
+    my @ops;
+    my $disp_reg   := $regalloc.fresh_register($MVM_reg_obj);
+    my $isnull_reg := $regalloc.fresh_register($MVM_reg_int64);
+    my $done_lbl   := MAST::Label.new();
+    %core_op_generators{'takenextdispatcher'}($disp_reg);
+    %core_op_generators{'isnull'}($isnull_reg, $disp_reg);
+    %core_op_generators{'if_i'}($isnull_reg, $done_lbl);
+    if $*BLOCK.lexical($op[0].value) -> $lex {
+        %core_op_generators{'bindlex'}($lex, $disp_reg);
+    }
+    $*MAST_FRAME.add-label($done_lbl);
+    $regalloc.release_register($disp_reg, $MVM_reg_obj);
+    $regalloc.release_register($isnull_reg, $MVM_reg_int64);
+    MAST::InstructionList.new(MAST::VOID, $MVM_reg_void)
+});
 QAST::MASTOperations.add_core_moarop_mapping('cleardispatcher', 'takedispatcher');
+QAST::MASTOperations.add_core_moarop_mapping('clearnextdispatcher', 'takenextdispatcher');
 QAST::MASTOperations.add_core_moarop_mapping('freshcoderef', 'freshcoderef');
 QAST::MASTOperations.add_core_moarop_mapping('iscoderef', 'iscoderef');
 QAST::MASTOperations.add_core_moarop_mapping('markcodestatic', 'markcodestatic');

t/nqp/100-dispatcher.t

@@ -1,4 +1,4 @@
-plan(10);
+plan(16);
 my $closure;
 {
     nqp::setdispatcher(100);
@@ -35,6 +35,18 @@ nqp::setdispatcherfor(300, &bar);
 foo();
 bar();
 
+sub baz() {
+    my $baz := 100;
+    nqp::takenextdispatcher('$baz');
+    is($baz, 400);
+    $baz := 200;
+    nqp::takenextdispatcher('$baz');
+    is($baz, 200);
+}
+
+nqp::nextdispatcherfor(400, &baz);
+baz();
+
 sub wraped1() {
     my $foo := 100;
     nqp::takedispatcher('$foo');
@@ -43,8 +55,11 @@ sub wraped1() {
 
 sub wraped2() {
     my $foo := 100;
+    my $bar := 100;
     nqp::takedispatcher('$foo');
+    nqp::takenextdispatcher('$bar');
     is($foo, 400);
+    is($bar, 420);
 }
 
 class Wrap {
@@ -56,6 +71,7 @@ my $wraped1 := Wrap.new(code_ref => &wraped1);
 my $wraped2 := Wrap.new(code_ref => &wraped2);
 
 nqp::setdispatcherfor(400, $wraped2);
+nqp::nextdispatcherfor(420, $wraped2);
 
 $wraped1();
 $wraped2();
@@ -75,3 +91,18 @@ is(take_or_clear(1), 400);
 nqp::setdispatcherfor(400, &take_or_clear);
 is(take_or_clear(0), 100);
 is(take_or_clear(1), 100);
+
+sub take_or_clear_next($take) {
+    my $foo := 100;
+    if $take {
+      nqp::takenextdispatcher('$foo');
+    } else {
+      nqp::clearnextdispatcher();
+    }
+    $foo;
+}
+nqp::nextdispatcherfor(400, &take_or_clear_next);
+is(take_or_clear_next(1), 400);
+nqp::nextdispatcherfor(400, &take_or_clear_next);
+is(take_or_clear_next(0), 100);
+is(take_or_clear_next(1), 100);