Implement :excl and :all for methods, attributes and parents. Make :e…

…xcl the default.
rakudo · Jan 9, 2012 · 1f302f8 · 1f302f8
1 parent b1d3c7c
commit 1f302f8
Show file tree

Hide file tree

Showing 6 changed files with 26 additions and 13 deletions.
diff --git a/src/Perl6/Metamodel/AttributeContainer.pm b/src/Perl6/Metamodel/AttributeContainer.pm
@@ -47,16 +47,15 @@ role Perl6::Metamodel::AttributeContainer {
     }
 
     # Introspect attributes.
-    method attributes($obj, :$local) {
+    method attributes($obj, :$local, :$excl, :$all) {
         my @attrs;
-
-        if $local {
-            for @!attributes {
-                @attrs.push($_);
-            }
+
+        for @!attributes {
+            @attrs.push($_);
         }
-        else {
-            for self.mro($obj) {
+
+        unless $local {
+            for self.parents($obj, :excl($excl), :all($all)) {
                 for $_.HOW.attributes($_, :local(1)) {
                     @attrs.push($_);
                 }

diff --git a/src/Perl6/Metamodel/MethodContainer.pm b/src/Perl6/Metamodel/MethodContainer.pm
@@ -33,7 +33,7 @@ role Perl6::Metamodel::MethodContainer {
     }
 
     # Gets the method hierarchy.
-    method methods($obj, :$local) {
+    method methods($obj, :$local, :$excl, :$all) {
         # Always need local methods on the list.
         my @meths;
         for @!method_order {
@@ -42,7 +42,7 @@ role Perl6::Metamodel::MethodContainer {
 
         # If local flag was not passed, include those from parents.
         unless $local {
-            for self.parents($obj) {
+            for self.parents($obj, :all($all), :excl($excl)) {
                 for $_.HOW.method_table($_) {
                     @meths.push($_.value);
                 }

diff --git a/src/Perl6/Metamodel/MultipleInheritance.pm b/src/Perl6/Metamodel/MultipleInheritance.pm
@@ -1,6 +1,12 @@
 role Perl6::Metamodel::MultipleInheritance {
     # Array of parents.
     has @!parents;
+
+    # Classes to exclude from the parents list in introspection by default.
+    my @excluded;
+    method exclude_parent($parent) {
+        @excluded.push($parent);
+    }
 
     # Adds a parent.
     method add_parent($obj, $parent) {
@@ -21,7 +27,7 @@ role Perl6::Metamodel::MultipleInheritance {
     }
 
     # Introspects the parents.
-    method parents($obj, :$local, :$tree) {
+    method parents($obj, :$local, :$tree, :$excl, :$all) {
         if $local {
             @!parents
         }
@@ -40,7 +46,13 @@ role Perl6::Metamodel::MultipleInheritance {
             my @parents;
             my $i := 1;
             while $i < +@mro {
-                @parents.push(@mro[$i]);
+                my $exclude := 0;
+                unless $all {
+                    for @excluded {
+                        $exclude := 1 if @mro[$i] =:= $_;
+                    }
+                }
+                @parents.push(@mro[$i]) unless $exclude;
                 $i := $i + 1;
             }
             @parents

diff --git a/src/core/Any.pm b/src/core/Any.pm
@@ -161,6 +161,7 @@ my class Any {
 
     method reduce(&with) { self.list.reduce(&with) }
 }
+Metamodel::ClassHOW.exclude_parent(Any);
 
 proto infix:<===>($?, $?) { * }
 multi infix:<===>($a?)    { Bool::True }

diff --git a/src/core/Cool.pm b/src/core/Cool.pm
@@ -181,6 +181,7 @@ my class Cool {
     method Num()  { self.Numeric.Num }
     method Rat()  { self.Numeric.Rat }
 }
+Metamodel::ClassHOW.exclude_parent(Cool);
 
 sub chop(Cool $s)                  { $s.chop }
 sub chomp(Cool $s)                 { $s.chomp }

diff --git a/src/core/Mu.pm b/src/core/Mu.pm
@@ -432,4 +432,4 @@ sub DUMP(|$) {
           !! $topic.DUMP()
     }
 };
-
+Metamodel::ClassHOW.exclude_parent(Mu);