Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Implement capture ~~ signature smart-matchng.

  • Loading branch information...
commit 6cd34324636343c15b4f3fa9b97143a095ff4e76 1 parent 61cbec6
Jonathan Worthington jnthn authored
Showing with 68 additions and 0 deletions.
  1. +1 −0  src/Perl6/Ops.pm
  2. +12 −0 src/core/Signature.pm
  3. +55 −0 src/ops/perl6.ops
1  src/Perl6/Ops.pm
View
@@ -27,6 +27,7 @@ $ops.add_hll_pirop_mapping('perl6', 'p6definite', 'perl6_definite', 'PP', :inlin
$ops.add_hll_pirop_mapping('perl6', 'p6multidispatch', 'perl6_enter_multi_dispatch_from_onlystar_block', 'P');
$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', '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');
12 src/core/Signature.pm
View
@@ -4,6 +4,18 @@ my class Signature {
# has $!returns; # return type
# has $!arity; # cached arity
# has $!count; # cached count
+
+ multi method ACCEPTS(Signature:D: Capture $topic) {
+ nqp::p6bool(nqp::p6isbindable(self, nqp::p6decont($topic)));
+ }
+
+ multi method ACCEPTS(Signature:D: @topic) {
+ self.ACCEPTS(@topic.Capture)
+ }
+
+ multi method ACCEPTS(Signature:D: %topic) {
+ self.ACCEPTS(%topic.Capture)
+ }
method arity() {
self.count if nqp::isnull($!arity) || !$!arity.defined;
55 src/ops/perl6.ops
View
@@ -520,6 +520,61 @@ inline op perl6_trial_bind_ct(out INT, in PMC, in PMC, in PMC) :base_core {
/*
+=item perl6_is_sig_bindable()
+
+Checks if a capture can be bound to a signature.
+
+=cut
+
+*/
+inline op perl6_is_sig_bindable(out INT, in PMC, in PMC) :base_core {
+ PMC *signature = $2;
+ PMC *capture = $3;
+ STRING *error = STRINGNULL;
+ PMC *lexpad, *ctx, *_do, *ret_cont, *call_object;
+ opcode_t *next;
+ INTVAL result;
+
+ /* Need to make sure some stuff doesn't get destroyed. */
+ PMC * const saved_ctx = CURRENT_CONTEXT(interp);
+ PMC * const saved_ccont = interp->current_cont;
+ PMC * const saved_sig = Parrot_pcc_get_signature(interp, saved_ctx);
+ opcode_t * const saved_pc = Parrot_pcc_get_pc(interp, saved_ctx);
+
+ /* Obtain code object from signature. */
+ PMC *code = ((Rakudo_Signature *)PMC_data(signature))->code;
+ if (PMC_IS_NULL(code)) {
+ $1 = 0;
+ goto NEXT();
+ }
+ _do = ((Rakudo_Code *)PMC_data(code))->_do;
+
+ /* Invoke the code that the signature belongs to. */
+ ret_cont = Parrot_pmc_new(interp, enum_class_Continuation);
+ call_object = Parrot_pmc_new(interp, enum_class_CallContext);
+ Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), call_object);
+ PARROT_CONTINUATION(ret_cont)->from_ctx = call_object;
+ Parrot_pcc_set_continuation(interp, call_object, ret_cont);
+ interp->current_cont = ret_cont;
+ next = VTABLE_invoke(interp, _do, saved_pc);
+ ctx = CURRENT_CONTEXT(interp);
+
+ /* Obtain lexpad. */
+ lexpad = Parrot_pcc_get_lex_pad(interp, ctx);
+
+ /* Call signature binder and stash outcome. */
+ result = Rakudo_binding_bind(interp, lexpad, signature, capture, 0, &error)
+ == BIND_RESULT_OK;
+
+ /* Invoke the return continuation. */
+ VTABLE_invoke(interp, ret_cont, next);
+
+ $1 = result;
+}
+
+
+/*
+
=item perl6_set_types_mu_any(in PMC, in PMC)
Sets the top type.
Please sign in to comment.
Something went wrong with that request. Please try again.