Fill out the implementation of .WALK such that it passes all of S12-i…

…ntrospection/walk.t.
rakudo · May 7, 2009 · 194b524 · 194b524
1 parent 06e2f1d
commit 194b524
Showing 1 changed file with 37 additions and 69 deletions.
diff --git a/src/setting/Object.pm b/src/setting/Object.pm
@@ -1,4 +1,4 @@
-subset Matcher of Object where { $_.can('ACCEPTS') };
+subset Matcher of Object where { .can('ACCEPTS') };
 
 class Object is also {
     multi method perl {
@@ -10,92 +10,60 @@ class Object is also {
     }
 
     method WALK(:$name!, :$canonical, :$ascendant, :$descendant, :$preorder, :$breadth,
-                :$super, Matcher :$omit, Matcher :$include) {
+                :$super, Matcher :$omit = False, Matcher :$include = True) {
         # First, build list of classes in the order we'll need them.
         my @classes;
         if $super {
             @classes = self.^parents(:local);
         } else {
             if $breadth {
-                die ":breadth unimplemented";
-            } elsif $ascendant {
-                die ":ascendant unimplemented";
-            } elsif $descendant {
-                die ":descendant unimplemented";
-            } elsif $preorder {
-                die ":preorder unimplemented";
-            } else {
-                # Canonical, the default.
-                my sub merge_c3(@to_merge) {
-                    my $accepted;
-                    my $found = 0;
-                    my $cand_count = 0;
-                    loop (my $i = 0; $i < +@to_merge; $i++) {
-                        if +@to_merge[$i] {
-                            $cand_count++;
-                            my $cand_class = @to_merge[$i][0];
-                            my $reject = False;
-                            loop (my $j = 0; $j < +@to_merge; $j++) {
-                                if $i != $j {
-                                    loop (my $k = 1; $k < +@to_merge[$j]; $k++) {
-                                        if @to_merge[$j][$k].WHAT =:= $cand_class.WHAT {
-                                            $reject = True;
-                                            last;
-                                        }
-                                    }
-                                }
-                            }
-                            unless $reject {
-                                $accepted = $cand_class;
-                                $found = 1;
-                                last;
+                my @search_list = self.WHAT;
+                while @search_list {
+                    push @classes, @search_list.list();
+                    my @new_search_list;
+                    for @search_list -> $current {
+                        for $current.^parents(:local) -> $next {
+                            unless any(@new_search_list <<===>> $next) {
+                                push @new_search_list, $next;
                             }
                         }
                     }
-                    if !$cand_count {
-                        return ();
-                    }
-                    if !$found {
-                        die "Could not build C3 linearization: ambiguous hierarchy";
-                    }
-                    for @to_merge -> @cur_list is rw {
-                        @cur_list .= grep({ $^class.WHAT !=:= $accepted.WHAT });
+                    @search_list = @new_search_list;
+                }
+            } elsif $ascendant | $preorder {
+                my sub build_ascendent($class) {
+                    unless any(@classes <<===>> $class) {
+                        push @classes, $class;
+                        for $class.^parents(:local) {
+                            build_ascendent($^parent);
+                        }
                     }
-                    my @result = merge_c3(@to_merge);
-                    unshift @result, $accepted;
-                    return @result;
                 }
-                my sub compute_c3($class) {
-                    my @immediates = $class.^parents(:local);
-                    if @immediates.elems == 0 {
-                        @classes = $class;
-                    } else {
-                        my @to_merge = @immediates.map({ [compute_c3($^parent)] });
-                        push @to_merge, [@immediates];
-                        my @merged = merge_c3(@to_merge);
-                        unshift @merged, $class;
-                        return @merged;
+                build_ascendent(self.WHAT);
+            } elsif $descendant {
+                my sub build_descendent($class) {
+                    unless any(@classes <<===>> $class) {
+                        for $class.^parents(:local) {
+                            build_descendent($^parent);
+                        }
+                        push @classes, $class;
                     }
                 }
-                @classes = compute_c3(self.WHAT());
+                build_descendent(self.WHAT);
+            } else {
+                # Canonical, the default (just whatever the meta-class says).
+                @classes = self.^parents();
             }
         }
-
-        # Filter as needed.
-        if $omit {
-            @classes .= grep { !$omit.ACCEPTS($_) };
-        }
-        if $include {
-            @classes .= grep { !$include.ACCEPTS($_) };
-        }
-
         # Now we have classes, build method list.
         my @methods;
         for @classes -> $class {
-            for $class.^methods() -> $method {
-                my $check_name = $method.?name;
-                if $check_name.defined && $check_name eq $name {
-                    @methods.push($method);
+            if $include.ACCEPTS($class) && !$omit.ACCEPTS($class) {
+                for $class.^methods() -> $method {
+                    my $check_name = $method.?name;
+                    if $check_name.defined && $check_name eq $name {
+                        @methods.push($method);
+                    }
                 }
             }
         }