Implement binding with declarators.

This gets things like 'my (:$a, :$b) := foo()' style things working.
rakudo · Sep 28, 2012 · 14f0230 · 14f0230
1 parent fdf347b
commit 14f0230
Show file tree

Hide file tree

Showing 3 changed files with 58 additions and 1 deletion.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -1524,7 +1524,18 @@ class Perl6::Actions is HLL::Actions {
                     $/.CURSOR.panic("Cannot use .= initializer with a list of declarations");
                 }
                 else {
-                    $*W.throw($/, 'X::Comp::NYI', feature => "Binding to signatures in $*SCOPE declarations");
+                    my %sig_info := $<signature>.ast;
+                    my @params := %sig_info<parameters>;
+                    set_default_parameter_type(@params, 'Mu');
+                    my $signature := create_signature_object($/, %sig_info, $*W.cur_lexpad());
+                    $list := QAST::Op.new(
+                        :op('p6bindcaptosig'),
+                        QAST::WVal.new( :value($signature) ),
+                        QAST::Op.new(
+                            :op('callmethod'), :name('Capture'),
+                            $<initializer>[0].ast
+                        )
+                    );
                 }
                 if $*SCOPE eq 'state' {
                     $list := QAST::Op.new( :op('if'),

diff --git a/src/Perl6/Ops.pm b/src/Perl6/Ops.pm
@@ -28,6 +28,7 @@ $ops.add_hll_pirop_mapping('perl6', 'p6multidispatch', 'perl6_enter_multi_dispat
 $ops.add_hll_pirop_mapping('perl6', 'p6multidispatchlex', 'perl6_enter_multi_dispatch_in_lexical_context', 'P');
 $ops.add_hll_pirop_mapping('perl6', 'p6bindsig', 'bind_signature', 'v');
 $ops.add_hll_pirop_mapping('perl6', 'p6isbindable', 'perl6_is_sig_bindable', 'IPP');
+$ops.add_hll_pirop_mapping('perl6', 'p6bindcaptosig', 'perl6_bind_sig_to_cap', '0PP');
 $ops.add_hll_pirop_mapping('perl6', 'p6typecheckrv', 'perl6_type_check_return_value', '0PP', :inlinable(1));
 $ops.add_hll_pirop_mapping('perl6', 'p6decontrv', 'perl6_decontainerize_return_value', 'PP', :inlinable(1));
 $ops.add_hll_pirop_mapping('perl6', 'p6capturelex', 'perl6_capture_lex', '0P');

diff --git a/src/ops/perl6.ops b/src/ops/perl6.ops
@@ -463,6 +463,51 @@ inline op bind_signature() :base_core {
 }
 
 
+/*
+
+=item perl6_bind_sig_to_cap()
+
+Takes a signature and capture. Binds it in the current lexical context.
+
+=cut
+
+*/
+inline op perl6_bind_sig_to_cap(in PMC, in PMC) :base_core {
+    PMC *signature = $1;
+    PMC *capture   = $2;
+
+    /* Need to make sure some stuff doesn't get destroyed. */
+    PMC      * const ctx         = CURRENT_CONTEXT(interp);
+    PMC      * const saved_ccont = interp->current_cont;
+    PMC      * const saved_sig   = Parrot_pcc_get_signature(interp, ctx);
+    opcode_t * const current_pc  = Parrot_pcc_get_pc(interp, ctx);
+
+    /* Obtain lexpad and other settings. */
+    PMC * const lexpad        = Parrot_pcc_get_lex_pad(interp, ctx);
+    STRING * error            = STRINGNULL;
+    INTVAL bind_error;
+
+    /* Call signature binder. */
+    bind_error = Rakudo_binding_bind(interp, lexpad, signature,
+        capture, 0, &error);
+
+    /* Bind ok? */
+    if (!bind_error) {
+        /* Re-instate anything we may have damaged. */
+        CURRENT_CONTEXT(interp) = ctx;
+        interp->current_cont    = saved_ccont;
+        Parrot_pcc_set_signature(interp, ctx, saved_sig);
+        Parrot_pcc_set_pc(interp, ctx, current_pc);
+        goto NEXT();
+    }
+    else {
+        opcode_t * const handler = Parrot_ex_throw_from_op_args(interp, NULL,
+                EXCEPTION_INVALID_OPERATION, "%Ss", error);
+        goto ADDRESS(handler);
+    }
+}
+
+
 /*
 
 =item perl6_trial_bind_ct()