[svn:parrot] r35759 - in trunk/languages/perl6/src: classes pmc

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