Get .^parents and .^methods a bit more in line with spec; update WALK.

rakudo · May 6, 2009 · 871c1e3 · 871c1e3
1 parent 45fcaee
commit 871c1e3
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 4 deletions.
diff --git a/src/parrot/ClassHOW.pir b/src/parrot/ClassHOW.pir
@@ -41,16 +41,33 @@ Gets a list of this class' parents.
 
 =cut
 
-.sub 'isa' :method :multi(_,_)
+.sub 'parents' :method
     .param pmc obj
+    .param pmc local         :named('local') :optional
+    .param pmc hierarchical  :named('hierarchical') :optional
     
     .local pmc parrot_class, result_list, parrot_list, it
     result_list = get_hll_global 'Array'
     result_list = result_list.'new'()
     parrot_class = self.'get_parrotclass'(obj)
+    
+    # Fake top of Perl 6 hierarchy
     $S0 = parrot_class.'name'()
-    if $S0 == 'Perl6Object' goto it_loop_end # Fake top of Perl 6 hierarchy
+    if $S0 != 'Perl6Object' goto not_object
+    unless null local goto done
+    $P0 = get_hll_global 'Object'
+    result_list.'push'($P0)
+    goto done
+  not_object:
+
+    # If it's local or default, can just use inspect.
+    unless null hierarchical goto do_hierarchical
+    if null local goto all_parents
     parrot_list = inspect parrot_class, 'parents'
+    goto have_list
+  all_parents:
+    parrot_list = inspect parrot_class, 'all_parents'
+  have_list:
     it = iter parrot_list
   it_loop:
     unless it goto it_loop_end
@@ -60,7 +77,12 @@ Gets a list of this class' parents.
     result_list.'push'($P0)
     goto it_loop
   it_loop_end:
+    goto done
+
+  do_hierarchical:
+    'die'(':hierarchical not yet implemented')
 
+  done:
     .return (result_list)
 .end
 

diff --git a/src/setting/Object.pm b/src/setting/Object.pm
@@ -14,7 +14,7 @@ class Object is also {
         # First, build list of classes in the order we'll need them.
         my @classes;
         if $super {
-            @classes = self.^isa();
+            @classes = self.^parents(:local);
         } else {
             if $breadth {
                 die ":breadth unimplemented";
@@ -66,7 +66,7 @@ class Object is also {
                     return @result;
                 }
                 my sub compute_c3($class) {
-                    my @immediates = $class.^isa();
+                    my @immediates = $class.^parents(:local);
                     if @immediates.elems == 0 {
                         @classes = $class;
                     } else {