[svn:parrot] r35771 - in trunk/languages/perl6/src: classes parser

Author: jonathan
Date: Mon Jan 19 12:12:04 2009
New Revision: 35771

Modified:
   trunk/languages/perl6/src/classes/Junction.pir
   trunk/languages/perl6/src/parser/actions.pm

Log:
[rakudo] Handle auto-threading of named arguments correctly. (The named ones that passed in the single dispatch case seem to have done so as a result of a Parrot bug; this gets them passing for real and also handles 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 12:12:04 2009
@@ -232,6 +232,7 @@
 .sub '!DISPATCH_JUNCTION'
     .param pmc the_sub
     .param pmc args            :slurpy
+    .param pmc name_args       :slurpy :named
 
     ##  lookup a sub by name if needed
     $I0 = isa the_sub, 'Sub'
@@ -246,8 +247,9 @@
     .local int argc, index, index_save
     argc = args
     index = 0
+    index_save = -1
   left_loop:
-    unless index < argc goto left_done
+    unless index < argc goto all_done
     .local pmc junc
     junc = args[index]
     $I0 = isa junc, 'Junction'
@@ -275,9 +277,32 @@
   all_done:
     index = index_save
     junc = args[index]
+
+    # If we don't have a junction now, need to check for anything in named.
+    .local int found_junction
+    found_junction = isa junc, 'Junction'
+    unless found_junction goto check_named
     type = junc.'!type'()
-  have_index:
+  check_named:
+    .local pmc name_iter, name_junc
+    .local string cur_name, name_index
+    name_iter = iter name_args
+  name_loop:
+    unless name_iter goto name_loop_end
+    cur_name = shift name_iter
+    name_junc = name_args[cur_name]
+    $I0 = isa name_junc, 'Junction'
+    unless $I0 goto name_loop
+    $I0 = name_junc.'!type'()
+    if $I0 >= JUNCTION_TYPE_ALL goto have_named_index
+    if found_junction goto name_loop
+  have_named_index:
+    junc = name_junc
+    type = $I0
+    name_index = cur_name
+  name_loop_end:
 
+  have_index:
     .local pmc eigenstates, it, results
     eigenstates = junc.'!eigenstates'()
     it = iter eigenstates
@@ -285,8 +310,13 @@
   thread_loop:
     unless it goto thread_done
     $P0 = shift it
+    unless null name_index goto thread_named
     args[index] = $P0
-    $P0 = the_sub(args :flat)
+    goto do_threaded_call
+  thread_named:
+    name_args[name_index] = $P0
+  do_threaded_call:
+    $P0 = the_sub(args :flat, name_args :flat :named)
     push results, $P0
     goto thread_loop
   thread_done:

Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm	(original)
+++ trunk/languages/perl6/src/parser/actions.pm	Mon Jan 19 12:12:04 2009
@@ -1073,6 +1073,11 @@
             my $sigparam := PAST::Op.new( :pasttype('callmethod'),
                                 :name('!add_param'), $sigobj, $name );
 
+            ##  if it's named, note that in the signature object
+            if $var.named() ne "" {
+                $sigparam.push(PAST::Val.new( :value($var.named()), :named('named') ));
+            }
+
             ##  add any typechecks
             my $type := $var<type>;
             if +@($type) > 0 {