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 {
