From f9001fa2ba2bc7f53ba4245fc18134cac874b6f8 Mon Sep 17 00:00:00 2001
From: Jonathan Worthington <jnthn@jnthn.net>
Date: Tue, 12 Jan 2010 23:02:36 +0100
Subject: [PATCH] Bunch of fixes to get parametric roles just about working
 again.

---
 src/Perl6/Actions.pm         |  4 +++-
 src/Perl6/Compiler/Role.pm   | 11 ++++++++++-
 src/builtins/Role.pir        |  1 -
 src/cheats/parrot/P6role.pir |  1 +
 src/core/traits.pm           |  2 +-
 src/glue/role.pir            |  1 +
 src/metamodel/RoleHOW.pir    | 15 +++------------
 7 files changed, 19 insertions(+), 16 deletions(-)

diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
index 14c3f30d77b..d9075b40f21 100644
--- a/src/Perl6/Actions.pm
+++ b/src/Perl6/Actions.pm
@@ -569,12 +569,14 @@ method package_def($/, $key?) {
         if $<def_module_name> {
             my $name := ~$<def_module_name>[0]<longname>;
             if $name ne '::' {
-                $package.name($name);
                 $/.CURSOR.add_name($name);
+                $package.name($name);
             }
             if $<def_module_name>[0]<signature> {
                 $package.signature($<def_module_name>[0]<signature>[0].ast);
+                $package.signature_text(~$<def_module_name>[0]<signature>[0]);
             }
+            
         }
 
         # Add traits.
diff --git a/src/Perl6/Compiler/Role.pm b/src/Perl6/Compiler/Role.pm
index 9d0d87c0492..b2fa81014ae 100644
--- a/src/Perl6/Compiler/Role.pm
+++ b/src/Perl6/Compiler/Role.pm
@@ -3,12 +3,21 @@ class Perl6::Compiler::Role is Perl6::Compiler::Package;
 # Holds the signautre for this parametric role, if any.
 has $!signature;
 
+# Textual representation of the signature, for constructing the long package name.
+has $!signature_text;
+
 # Accessor for signature.
 method signature($signature?) {
     if pir::defined__IP($signature) { $!signature := $signature }
     $!signature
 }
 
+# Accessor for signature text.
+method signature_text($signature_text?) {
+    if pir::defined__IP($signature_text) { $!signature_text := $signature_text }
+    pir::isnull__IP($!signature_text) ?? '' !! $!signature_text
+}
+
 # Do the code generation for the parametric role.
 method finish($block) {
     my $decl := PAST::Stmts.new();
@@ -119,7 +128,7 @@ method finish($block) {
         
         # Set namespace and install in package, if our scoped.
         if $!scope eq 'our' {
-            my @ns := Perl6::Grammar::parse_name($name);
+            my @ns := Perl6::Grammar::parse_name($name ~ '[' ~ self.signature_text ~ ']');
             $block.namespace(@ns);
             my @PACKAGE := Q:PIR { %r = get_hll_global ['Perl6'; 'Actions'], '@PACKAGE' };
             @PACKAGE[0].block.loadinit().push(PAST::Op.new(
diff --git a/src/builtins/Role.pir b/src/builtins/Role.pir
index 1b4fecf4a25..3952fa3c58b 100644
--- a/src/builtins/Role.pir
+++ b/src/builtins/Role.pir
@@ -24,7 +24,6 @@ short name for a particular set of parameters.
     .local pmc p6meta, roleproto
     p6meta = get_hll_global ['Mu'], '$!P6META'
     roleproto = p6meta.'new_class'('Perl6Role', 'parent'=>'Any', 'name'=>'Role', 'attr'=>'$!selector $!created $!shortname')
-    p6meta.'register'('P6role', 'proto'=>'roleproto')
 .end
 
 
diff --git a/src/cheats/parrot/P6role.pir b/src/cheats/parrot/P6role.pir
index 740b007b590..6413f18813d 100644
--- a/src/cheats/parrot/P6role.pir
+++ b/src/cheats/parrot/P6role.pir
@@ -172,6 +172,7 @@ XXX TODO: Needs a complete re-write for ng.
 =cut
 
 .sub 'HOW' :method
+    self = descalarref self
     $P0 = getprop 'metaclass', self
     .return ($P0)
 .end
diff --git a/src/core/traits.pm b/src/core/traits.pm
index 182d7552667..6b847dab53d 100644
--- a/src/core/traits.pm
+++ b/src/core/traits.pm
@@ -13,7 +13,7 @@ our multi trait_mod:<of>(ContainerDeclarand $cont, Mu \$type) {
     }
 }
 
-our multi trait_mod:<does>(Mu $target, Role $r) {
+our multi trait_mod:<does>(Mu $target, Mu $r) {
     $target.add_composable($target, $r);
 }
 
diff --git a/src/glue/role.pir b/src/glue/role.pir
index 7ccd7da13af..b1e0d6f8b07 100644
--- a/src/glue/role.pir
+++ b/src/glue/role.pir
@@ -19,6 +19,7 @@ Creates a master-role object, containing all the various role variants.
 .sub '!create_master_role'
     .param pmc shortname
     .param pmc existing
+    if null existing goto need_new
     $I0 = isa existing, 'Perl6Role'
     unless $I0 goto need_new
     .return (existing)
diff --git a/src/metamodel/RoleHOW.pir b/src/metamodel/RoleHOW.pir
index f6444bb5e38..4863dfc69d9 100644
--- a/src/metamodel/RoleHOW.pir
+++ b/src/metamodel/RoleHOW.pir
@@ -39,18 +39,9 @@ Creates a new instance of the meta-class.
 
 .sub 'new' :method
     .param pmc name :optional
-    .local pmc how, p6role, nsarray, ns
-    if null name goto anon_role
-
-    # Named role - associate with Parrot namespace.
-    $P0 = get_hll_global [ 'Perl6';'Grammar' ], 'parse_name'
-    nsarray = $P0(name)
-    ns = get_hll_namespace nsarray
-    p6role = new ['P6role'], ns
-    goto have_p6role
-
-    # Anonymous class - just create a new Parrot class and we're done.
-  anon_role:
+    .local pmc how, p6role
+
+    # Create P6role object, which is what we will install in the namespace.
     p6role = new ['P6role']
 
     # Stash in metaclass instance, init a couple of other fields,