Author: jonathan
Date: Wed Jan 21 05:18:29 2009
New Revision: 35861
Modified:
trunk/languages/perl6/src/builtins/guts.pir
trunk/languages/perl6/src/classes/ClassHOW.pir
Log:
[rakudo] Make 'handles' trait verb handle pairs, classes, roles and
smartmatching on anything else.
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 05:18:29 2009
@@ -631,19 +631,54 @@
trait = shift it
$S0 = trait[0]
if $S0 != 'trait_verb:handles' goto traitlist_loop
+
+ # 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.
.local pmc handles_it
$P0 = trait[1]
+ $I0 = isa $P0, 'Str'
+ if $I0 goto simple_handles
+ $I0 = isa $P0, 'List'
+ if $I0 goto simple_handles
+ $I0 = isa $P0, 'Perl6Pair'
+ if $I0 goto simple_handles
+
+ .local pmc class_handles_list, handles_hash
+ class_handles_list = getprop '@!handles_dispatchers', metaclass
+ unless null class_handles_list goto have_class_handles_list
+ class_handles_list = new 'ResizablePMCArray'
+ setprop metaclass, '@!handles_dispatchers', class_handles_list
+ have_class_handles_list:
+ handles_hash = new 'Hash'
+ handles_hash['attrname'] = name
+ handles_hash['match_against'] = $P0
+ push class_handles_list, handles_hash
+ goto traitlist_loop
+
+ simple_handles:
$P0 = 'list'($P0)
handles_it = iter $P0
handles_loop:
+ .local string visible_name
+ .local pmc orig_name
unless handles_it goto handles_done
$P0 = clone handles
$P1 = box name
setprop $P0, 'attrname', $P1
$P1 = shift handles_it
- setprop $P0, 'methodname', $P1
- $S1 = $P1
- metaclass.'add_method'($S1, $P0)
+ $I0 = isa $P1, 'Perl6Pair'
+ if $I0 goto handles_pair
+ visible_name = $P1
+ orig_name = $P1
+ goto naming_done
+ handles_pair:
+ visible_name = $P1.'key'()
+ orig_name = $P1.'value'()
+ naming_done:
+ setprop $P0, 'methodname', orig_name
+ metaclass.'add_method'(visible_name, $P0)
goto handles_loop
handles_done:
goto traitlist_loop
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 05:18:29 2009
@@ -72,14 +72,49 @@
submethod_check_done:
# Got a method that we can call. XXX Set up exception handlers for if we
- # have to do auto-threading of junctional arguments, additionally if we
# get a control expection for callsame or nextsame etc. Won't be able to
# be tailcall then...
.tailcall obj.candidate(pos_args :flat, name_args :flat :named)
check_handles:
- # XXX This is where we will insert logic to run any regex or more complex
- # 'handles' things to try and find a handler.
+ # See if we have any complex handles to check.
+ .local pmc handles_list, handles_it, handles_hash, attr
+ 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
+ if null attr goto handles_loop
+ $P0 = handles_hash['match_against']
+
+ # If we have a class or role, should get its method list and check if it
+ # .can do that. Otherwise, smart-match against method name.
+ $I0 = isa $P0, 'P6protoobject'
+ if $I0 goto handles_proto
+ $I0 = isa $P0, 'Perl6Role'
+ if $I0 goto handles_role
+ $I0 = isa $P0, 'Role'
+ if $I0 goto handles_parrotrole
+ $P1 = $P0.'ACCEPTS'(name)
+ unless $P1 goto handles_loop
+ .tailcall attr.name(pos_args :flat, name_args :flat :named)
+
+ handles_proto:
+ $P1 = get_hll_global ['Perl6Object'], '$!P6META'
+ $P0 = $P1.'get_parrotclass'($P0)
+ goto handles_have_pc
+ handles_role:
+ $P0 = $P0.'!select'()
+ handles_parrotrole:
+ handles_have_pc:
+ $P1 = $P0.'methods'()
+ $I0 = exists $P1[name]
+ unless $I0 goto handles_loop
+ .tailcall attr.name(pos_args :flat, name_args :flat :named)
+ handles_loop_end:
goto mro_loop
pmc_proxy:
