Lots of fixes to get method introspection mostly working. Not 100% th…

…ere 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

@@ -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()
 

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'

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

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

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
 

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

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