Make roles inheritalizable; implement inheritalize (which just return…

…s the pun), so class Foo is SomeRole { } works again.
rakudo · Sep 9, 2011 · 9a0650a · 9a0650a
1 parent 1ff410a
commit 9a0650a
Show file tree

Hide file tree

Showing 3 changed files with 12 additions and 2 deletions.
diff --git a/src/Perl6/Metamodel/CurriedRoleHOW.pm b/src/Perl6/Metamodel/CurriedRoleHOW.pm
@@ -23,7 +23,7 @@ class Perl6::Metamodel::CurriedRoleHOW
     has @!pos_args;
     has %!named_args;
 
-    my $archetypes := Perl6::Metamodel::Archetypes.new( :nominal(1), :composable(1), :parametric(1) );
+    my $archetypes := Perl6::Metamodel::Archetypes.new( :nominal(1), :composable(1), :inheritalizable(1), :parametric(1) );
     method archetypes() {
         $archetypes
     }

diff --git a/src/Perl6/Metamodel/ParametricRoleHOW.pm b/src/Perl6/Metamodel/ParametricRoleHOW.pm
@@ -16,7 +16,7 @@ class Perl6::Metamodel::ParametricRoleHOW
     has $!composed;
     has $!body_block;
 
-    my $archetypes := Perl6::Metamodel::Archetypes.new( :nominal(1), :composable(1), :parametric(1) );
+    my $archetypes := Perl6::Metamodel::Archetypes.new( :nominal(1), :composable(1), :inheritalizable(1), :parametric(1) );
     method archetypes() {
         $archetypes
     }

diff --git a/src/Perl6/Metamodel/RolePunning.pm b/src/Perl6/Metamodel/RolePunning.pm
@@ -25,6 +25,16 @@ role Perl6::Metamodel::RolePunning {
         $pun
     }
 
+    # Produces something that can be inherited from (the pun).
+    method inheritalize($obj) {
+        if $!made_pun {
+            $!pun
+        }
+        else {
+            $!pun := self.make_pun($obj);
+        }
+    }
+
     # Do a pun-based dispatch. If we pun, return a thunk that will delegate.
     method find_method($obj, $name) {
         if pir::exists(%exceptions, $name) {