Author: jonathan
Date: Mon Jan 19 07:42:50 2009
New Revision: 35759
Modified:
trunk/languages/perl6/src/classes/Junction.pir
trunk/languages/perl6/src/pmc/perl6multisub.pmc
Log:
[rakudo] Make auto-threading work in the multi-dispatch case.
Modified: trunk/languages/perl6/src/classes/Junction.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Junction.pir (original)
+++ trunk/languages/perl6/src/classes/Junction.pir Mon Jan 19 07:42:50 2009
@@ -236,6 +236,8 @@
## lookup a sub by name if needed
$I0 = isa the_sub, 'Sub'
if $I0 goto have_sub
+ $I0 = isa the_sub, 'MultiSub'
+ if $I0 goto have_sub
$S0 = the_sub
the_sub = find_name $S0
have_sub:
@@ -349,7 +351,7 @@
pi = new 'ParrotInterpreter'
sub = pi['sub']
sub = getprop 'sub', sub
- .tailcall '!DISPATCH_JUNCTION'(sub, pos_args :flat, name_args :flat)
+ .tailcall '!DISPATCH_JUNCTION'(sub, pos_args :flat, name_args :flat :named)
.end
Modified: trunk/languages/perl6/src/pmc/perl6multisub.pmc
==============================================================================
--- trunk/languages/perl6/src/pmc/perl6multisub.pmc (original)
+++ trunk/languages/perl6/src/pmc/perl6multisub.pmc Mon Jan 19 07:42:50 2009
@@ -423,10 +423,35 @@
return result;
}
+
+/*
+
+=item C<static INTVAL has_junctional_args(PARROT_INTERP, PMC *args)>
+
+Checks if any of the args are junctional.
+
+=cut
+
+*/
+
+static INTVAL has_junctional_args(PARROT_INTERP, PMC *args) {
+ INTVAL num_args = VTABLE_elements(interp, args);
+ STRING *junction = CONST_STRING(interp, "Junction");
+ INTVAL i;
+ for (i = 0; i < num_args; i++) {
+ PMC *arg = VTABLE_get_pmc_keyed_int(interp, args, i);
+ if (VTABLE_isa(interp, arg, junction))
+ return 1;
+ }
+ return 0;
+}
+
+
/*
-=item C<static PMC* do_dispatch(candidate_info **candidates, PMC *args,
- int many, int num_candidates, opcode_t *next, MMD_Cache *cache)>
+=item C<static PMC* do_dispatch(PARROT_INTERP, PMC *self, candidate_info
**candidates,
+ PMC *proto, PMC *args, int many, int
num_candidates,
+ opcode_t *next, MMD_Cache *cache)>
Runs the Perl 6 MMD algorithm. If many is set to a true value, returns a
ResizablePMCArray of all possible candidates, which may be empty. If many
@@ -438,7 +463,7 @@
*/
-static PMC* do_dispatch(PARROT_INTERP, candidate_info **candidates, PMC *proto,
+static PMC* do_dispatch(PARROT_INTERP, PMC *self, candidate_info **candidates,
PMC *proto,
PMC *args, int many, int num_candidates, opcode_t *next, MMD_Cache *cache)
{
INTVAL type_mismatch;
STRING *ACCEPTS = CONST_STRING(interp, "ACCEPTS");
@@ -601,6 +626,18 @@
if (possibles_count == 1) {
return possibles[0]->sub;
}
+ else if (possibles_count == 0 && has_junctional_args(interp, args)) {
+ /* Look up multi junction dispatcher, clone it, attach this
multi-sub
+ * as a property and hand that back as the dispatch result. We also
+ * stick it in the MMD cache for next time around. */
+ PMC *sub = Parrot_find_global_n(interp,
Parrot_get_ctx_HLL_namespace(interp),
+ CONST_STRING(interp, "!DISPATCH_JUNCTION_MULTI"));
+ sub = VTABLE_clone(interp, sub);
+ VTABLE_setprop(interp, sub, CONST_STRING(interp, "sub"), self);
+ if (cache)
+ Parrot_mmd_cache_store_by_values(interp, cache, "", args, sub);
+ return sub;
+ }
else if (!PMC_IS_NULL(proto)) {
/* If we have a proto at this point, use that. */
return proto;
@@ -819,7 +856,7 @@
/* Now do the dispatch on the args we are being invoked with;
* if it can't find anything, it will throw the required
exception. */
- found = do_dispatch(interp, candidates, proto, args,
MMD_ONE_RESULT,
+ found = do_dispatch(interp, SELF, candidates, proto, args,
MMD_ONE_RESULT,
VTABLE_elements(interp, unsorted), (opcode_t *)next,
cache);
}
@@ -878,7 +915,7 @@
/* Now do the dispatch on the args we have been supplied with, and
* get back a PMC array of possibles. */
- results = do_dispatch(interp, candidates, proto, args,
MMD_MANY_RESULTS,
+ results = do_dispatch(interp, SELF, candidates, proto, args,
MMD_MANY_RESULTS,
VTABLE_elements(interp, unsorted), NULL, NULL);
/* Restore stuff that might have got overwriten by calls during the
