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);