Make role Foo[::T] does Bar[T] { ... } work.

rakudo · Sep 19, 2011 · e062a4c · e062a4c
1 parent 7563146
commit e062a4c
Show file tree

Hide file tree

Showing 2 changed files with 36 additions and 3 deletions.
diff --git a/src/Perl6/Metamodel/CurriedRoleHOW.pm b/src/Perl6/Metamodel/CurriedRoleHOW.pm
@@ -23,9 +23,22 @@ class Perl6::Metamodel::CurriedRoleHOW
     has @!pos_args;
     has %!named_args;
 
-    my $archetypes := Perl6::Metamodel::Archetypes.new( :nominal(1), :composable(1), :inheritalizable(1), :parametric(1) );
+    my $archetypes_g := Perl6::Metamodel::Archetypes.new( :composable(1), :inheritalizable(1), :parametric(1), :generic(1) );
+    my $archetypes_ng := Perl6::Metamodel::Archetypes.new( :nominal(1), :composable(1), :inheritalizable(1), :parametric(1) );
     method archetypes() {
-        $archetypes
+        if pir::repr_defined__IP(self) {
+            for @!pos_args {
+                if $_.HOW.archetypes.generic {
+                    return $archetypes_g;
+                }
+            }
+            for %!named_args {
+                if $_.value.HOW.archetypes.generic {
+                    return $archetypes_g;
+                }
+            }
+        }
+        $archetypes_ng
     }
 
     method new_type($curried_role, *@pos_args, *%named_args) {
@@ -35,6 +48,22 @@ class Perl6::Metamodel::CurriedRoleHOW
         pir::stable_set_type_check_mode__0PI($type, 2)
     }
 
+    method instantiate_generic($obj, $type_env) {
+        my @new_pos;
+        my %new_named;
+        for @!pos_args {
+            @new_pos.push($_.HOW.archetypes.generic ??
+                $_.HOW.instantiate_generic($_, $type_env) !!
+                $_);
+        }
+        for %!named_args {
+            %new_named{$_.key} := $_.value.HOW.archetypes.generic ??
+                $_.value.HOW.instantiate_generic($_.value, $type_env) !!
+                $_.value;
+        }
+        self.new_type($!curried_role, |@new_pos, |%new_named)
+    }
+
     method specialize($obj, $first_arg) {
         $!curried_role.HOW.specialize($!curried_role, $first_arg,
             |@!pos_args, |%!named_args);

diff --git a/src/Perl6/Metamodel/ParametricRoleHOW.pm b/src/Perl6/Metamodel/ParametricRoleHOW.pm
@@ -159,7 +159,11 @@ class Perl6::Metamodel::ParametricRoleHOW
         # Roles done by this role need fully specializing also; all
         # they'll be missing is the target class (e.g. our first arg).
         for self.roles_to_compose($obj) {
-            $conc.HOW.add_role($conc, $_.HOW.specialize($_, @pos_args[0]));
+            my $r := $_;
+            if $_.HOW.archetypes.generic {
+                $r := $r.HOW.instantiate_generic($r, $type_env);
+            }
+            $conc.HOW.add_role($conc, $r.HOW.specialize($r, @pos_args[0]));
         }
 
         # XXX More to copy/instantiate