From 1ff28a33d5c77ad00b81414fdd65860f0e7e63a0 Mon Sep 17 00:00:00 2001 From: jnthn Date: Tue, 9 Jun 2009 23:11:59 +0200 Subject: [PATCH] Lots of fixes to get method introspection mostly working. Not 100% there yet, but a whole load better than it was. Also prevents us getting quite so explodely when we're putting MultiSubs into arrays (Parrot's MultiSub inheriting from RPA is srsly stupid), and makes .name work on Multis too. --- src/classes/Code.pir | 8 +++++++ src/classes/List.pir | 2 ++ src/classes/Object.pir | 3 +++ src/classes/Routine.pir | 10 -------- src/parrot/ClassHOW.pir | 51 ++++++++++++++++++++++++++++++++++++----- src/parrot/misc.pir | 26 +++++++++++++++++++++ src/setting/Object.pm | 3 ++- 7 files changed, 86 insertions(+), 17 deletions(-) diff --git a/src/classes/Code.pir b/src/classes/Code.pir index f9201d1fcee..93d36b9cdaf 100644 --- a/src/classes/Code.pir +++ b/src/classes/Code.pir @@ -133,6 +133,14 @@ Just calls this block with the supplied parameters. .tailcall self(pos_args :flat, named_args :flat :named) .end +=item name + +=cut + +.sub 'name' :method + $S0 = self + .return ($S0) +.end =item perl() diff --git a/src/classes/List.pir b/src/classes/List.pir index b7a9fb91631..7f2b449ea37 100644 --- a/src/classes/List.pir +++ b/src/classes/List.pir @@ -317,6 +317,8 @@ layer. It will likely change substantially when we have lazy lists. if $I0 goto flat_next $I0 = isa elem, 'P6role' if $I0 goto flat_next + $I0 = isa elem, 'MultiSub' + if $I0 goto flat_next $I0 = can elem, '!flatten' if $I0 goto flat_elem $I0 = does elem, 'array' diff --git a/src/classes/Object.pir b/src/classes/Object.pir index 6d5213ddbe2..a55457d0623 100644 --- a/src/classes/Object.pir +++ b/src/classes/Object.pir @@ -63,9 +63,12 @@ like this. .macro fixup_cloned_sub(orig, copy) .local pmc tmp, tmp2 + .local string tmp_str tmp = getprop '$!signature', .orig if null tmp goto sub_fixup_done setprop .copy, '$!signature', tmp + tmp_str = typeof .orig + if tmp_str == "Sub" goto sub_fixup_done tmp = getattribute .orig, ['Sub'], 'proxy' tmp = getprop '$!real_self', tmp if null tmp goto sub_fixup_done diff --git a/src/classes/Routine.pir b/src/classes/Routine.pir index 0aacb49646c..e41264ab0d0 100644 --- a/src/classes/Routine.pir +++ b/src/classes/Routine.pir @@ -26,16 +26,6 @@ wrappable executable objects. =over 4 -=item name - -=cut - -.sub 'name' :method - $S0 = self - .return ($S0) -.end - - =item wrap =cut diff --git a/src/parrot/ClassHOW.pir b/src/parrot/ClassHOW.pir index f987bc9ebb8..8343e186251 100644 --- a/src/parrot/ClassHOW.pir +++ b/src/parrot/ClassHOW.pir @@ -44,8 +44,8 @@ Gets a list of this class' parents. .sub 'parents' :method .param pmc obj - .param pmc local :named('local') :optional - .param pmc hierarchical :named('hierarchical') :optional + .param pmc local :named('local') :optional + .param pmc tree :named('tree') :optional # Create result list. .local pmc parrot_class, result_list, parrot_list, it @@ -66,7 +66,7 @@ Gets a list of this class' parents. not_object: # If it's local can just use inspect. - unless null hierarchical goto do_hierarchical + unless null tree goto do_tree if null local goto all_parents parrot_list = inspect parrot_class, 'parents' it = iter parrot_list @@ -98,8 +98,8 @@ Gets a list of this class' parents. it_loop_end: goto done - do_hierarchical: - 'die'(':hierarchical not yet implemented') + do_tree: + 'die'(':tree not yet implemented') done: .return (result_list) @@ -118,15 +118,22 @@ XXX Fix bugs with introspecting some built-in classes (List, Str...) .sub 'methods' :method .param pmc obj + .param pmc adverbs :named :slurpy + + .local pmc local, tree, private + local = adverbs['local'] + tree = adverbs['tree'] + private = adverbs['private'] .local pmc parrot_class, method_hash, result_list, it, cur_meth + obj = obj.'WHAT'() parrot_class = self.'get_parrotclass'(obj) # Create array to put results in. result_list = get_root_global [.RAKUDO_HLL], 'Array' result_list = result_list.'new'() - # Get methods hash and build list of methods. + # Get methods for this class and build list of methods. method_hash = inspect parrot_class, "methods" it = iter method_hash it_loop: @@ -137,6 +144,38 @@ XXX Fix bugs with introspecting some built-in classes (List, Str...) goto it_loop it_loop_end: + # If we're in local mode or we reached the top of the hierarchy, we're done. + $S0 = parrot_class + if $S0 == 'Perl6Object' goto done + if null local goto not_local + if local goto done + not_local: + + # Otherwise, need to get methods of our parent classes too. Recurse; if + # we are wanting a hierarchical list then we push the resulting Array + # straight on, so it won't flatten. Otherwise we do .list so what we + # push will flatten. + .local pmc parents, cur_parent, parent_methods + parents = inspect parrot_class, 'parents' + it = iter parents + parent_it_loop: + unless it goto parent_it_loop_end + cur_parent = shift it + $I0 = isa cur_parent, 'PMCProxy' + if $I0 goto parent_it_loop + cur_parent = getprop 'metaclass', cur_parent + cur_parent = cur_parent.'WHAT'() + parent_methods = self.'methods'(cur_parent) + if null tree goto not_tree + if tree goto flatten_done + not_tree: + parent_methods = parent_methods.'list'() + flatten_done: + result_list.'push'(parent_methods) + goto parent_it_loop + parent_it_loop_end: + + done: .return (result_list) .end diff --git a/src/parrot/misc.pir b/src/parrot/misc.pir index 636ec5e8081..6e5b0d4708b 100644 --- a/src/parrot/misc.pir +++ b/src/parrot/misc.pir @@ -50,3 +50,29 @@ Note that we currently do this by adding the method to Parrot's .param string lang load_language lang .end + + +# Twiddle MultiSub - at least one of these can go away when it stops inheriting +# from RPA. + +.namespace ['MultiSub'] + +.sub 'Scalar' :method + .return (self) +.end + +=item name + +Gets the name of the routine. + +=cut + +.sub 'name' :method + # We'll just use the name of the first candidate. + $S0 = '' + $P0 = self[0] + if null $P0 goto done + $S0 = $P0 + done: + .return ($S0) +.end diff --git a/src/setting/Object.pm b/src/setting/Object.pm index 78b1f4463c9..ec0b45e6ff9 100644 --- a/src/setting/Object.pm +++ b/src/setting/Object.pm @@ -57,11 +57,12 @@ class Object is also { @classes.unshift(self.WHAT); } } + # Now we have classes, build method list. my @methods; for @classes -> $class { if $include.ACCEPTS($class) && !$omit.ACCEPTS($class) { - for $class.^methods() -> $method { + for $class.^methods(:local) -> $method { my $check_name = $method.?name; if $check_name.defined && $check_name eq $name { @methods.push($method);