[svn:parrot] r35864 - in trunk/languages/perl6/src: builtins classes

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