Author: jonathan
Date: Wed Jan 21 06:53:45 2009
New Revision: 35864
Modified:
trunk/languages/perl6/src/builtins/guts.pir
trunk/languages/perl6/src/classes/ClassHOW.pir
Log:
[rakudo] Implement use of has @array handles ... and also give an error if has
%x handles ... is used (the synopses reserve the syntax for now but don't
specify it).
Modified: trunk/languages/perl6/src/builtins/guts.pir
==============================================================================
--- trunk/languages/perl6/src/builtins/guts.pir (original)
+++ trunk/languages/perl6/src/builtins/guts.pir Wed Jan 21 06:53:45 2009
@@ -635,8 +635,11 @@
# For the handles trait verb, we may have got a name or a list of names.
# If so, just generate methods with those names. Otherwise, need to store
# them as a property on the metaclass, so the dispatcher can smart-match
- # against them later.
+ # against them later. Also, the % syntax is spec'd as reserved, so we give
+ # an error on that for now.
.local pmc handles_it
+ $S0 = substr name, 0, 1
+ if $S0 == '%' goto reserved_syntax_error
$P0 = trait[1]
$I0 = isa $P0, 'Str'
if $I0 goto simple_handles
@@ -683,6 +686,9 @@
handles_done:
goto traitlist_loop
traitlist_done:
+ .return ()
+ reserved_syntax_error:
+ 'die'("The use of a %hash with the handles trait verb is reserved")
.end
@@ -690,13 +696,27 @@
.param pmc args :slurpy
.param pmc options :slurpy :named
.local pmc method, attribute
+ .local string attrname
$P0 = getinterp
method = $P0['sub']
$P1 = getprop 'attrname', method
- $S1 = $P1
- attribute = getattribute self, $S1
+ attrname = $P1
+ attribute = getattribute self, attrname
$P1 = getprop 'methodname', method
$S1 = $P1
+ $S0 = substr attrname, 0, 1
+ if $S0 != '@' goto single_dispatch
+ .local pmc it
+ it = iter attribute
+ it_loop:
+ unless it goto it_loop_end
+ $P0 = shift it
+ $I0 = $P0.'can'($S1)
+ unless $I0 goto it_loop
+ .tailcall $P0.$S1(args :flat, options :flat :named)
+ it_loop_end:
+ 'die'("You used handles on attribute ", attrname, ", but nothing in the
array can do method ", $S1)
+ single_dispatch:
.tailcall attribute.$S1(args :flat, options :flat :named)
.end
Modified: trunk/languages/perl6/src/classes/ClassHOW.pir
==============================================================================
--- trunk/languages/perl6/src/classes/ClassHOW.pir (original)
+++ trunk/languages/perl6/src/classes/ClassHOW.pir Wed Jan 21 06:53:45 2009
@@ -79,14 +79,15 @@
check_handles:
# See if we have any complex handles to check.
.local pmc handles_list, handles_it, handles_hash, attr
+ .local string attrname
handles_list = getprop '@!handles_dispatchers', cur_class
if null handles_list goto mro_loop
handles_it = iter handles_list
handles_loop:
unless handles_it goto handles_loop_end
handles_hash = shift handles_it
- $S0 = handles_hash['attrname']
- attr = getattribute obj, $S0
+ attrname = handles_hash['attrname']
+ attr = getattribute obj, attrname
if null attr goto handles_loop
$P0 = handles_hash['match_against']
@@ -100,7 +101,7 @@
if $I0 goto handles_parrotrole
$P1 = $P0.'ACCEPTS'(name)
unless $P1 goto handles_loop
- .tailcall attr.name(pos_args :flat, name_args :flat :named)
+ goto do_handles_call
handles_proto:
$P1 = get_hll_global ['Perl6Object'], '$!P6META'
@@ -113,7 +114,21 @@
$P1 = $P0.'methods'()
$I0 = exists $P1[name]
unless $I0 goto handles_loop
+ do_handles_call:
+ $S0 = substr attrname, 0, 1
+ if $S0 == '@' goto handles_on_array
.tailcall attr.name(pos_args :flat, name_args :flat :named)
+ handles_on_array:
+ .local pmc handles_array_it
+ handles_array_it = iter attr
+ handles_array_it_loop:
+ unless handles_array_it goto handles_array_it_loop_end
+ $P0 = shift handles_array_it
+ $I0 = $P0.'can'(name)
+ unless $I0 goto handles_array_it_loop
+ .tailcall $P0.name(pos_args :flat, name_args :flat :named)
+ handles_array_it_loop_end:
+ 'die'("You used handles on attribute ", attrname, ", but nothing in the
array can do method ", name)
handles_loop_end:
goto mro_loop
