Generalize "can we augment this" checking.

Make it an archetype, and then opt classes in. Also tweak the exception type that is used to be more general, and try to make the wording of it general enough for all the cases we could get it, so it won't mislead.
rakudo · Mar 8, 2013 · c4280ee · c4280ee
1 parent 4080d67
commit c4280ee
Show file tree

Hide file tree

Showing 4 changed files with 13 additions and 8 deletions.
diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
@@ -1794,10 +1794,6 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
                     unless $*MONKEY_TYPING {
                         $/.CURSOR.typed_panic('X::Syntax::Augment::WithoutMonkeyTyping');
                     }
-                    if $*PKGDECL eq 'role' {
-                        $/.CURSOR.typed_panic('X::Syntax::Augment::Role',
-                                role-name => $longname.text);
-                    }
                     unless @name {
                         $*W.throw($/, 'X::Anon::Augment', package-kind => $*PKGDECL);
                     }
@@ -1811,6 +1807,10 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
                             package      => $longname.text(),
                         );
                     }
+                    unless $*PACKAGE.HOW.archetypes.augmentable {
+                        $/.CURSOR.typed_panic('X::Syntax::Augment::Illegal',
+                            package      => $longname.text);
+                    }
                 }
 
                 # Install $?PACKAGE, $?ROLE, $?CLASS, and :: variants as needed.

diff --git a/src/Perl6/Metamodel/Archetypes.pm b/src/Perl6/Metamodel/Archetypes.pm
@@ -40,6 +40,9 @@ class Perl6::Metamodel::Archetypes {
     # filled it before it's useful in some way.
     has $!parametric;
 
+    # Are we allowed to augment the type?
+    has $!augmentable;
+
     method nominal() { $!nominal }
     method nominalizable() { $!nominalizable }
     method inheritable() { $!inheritable }
@@ -48,4 +51,5 @@ class Perl6::Metamodel::Archetypes {
     method composalizable() { $!composalizable }
     method generic() { $!generic }
     method parametric() { $!parametric }
+    method augmentable() { $!augmentable }
 }
diff --git a/src/Perl6/Metamodel/ClassHOW.pm b/src/Perl6/Metamodel/ClassHOW.pm
@@ -31,7 +31,8 @@ class Perl6::Metamodel::ClassHOW
         $invoke_forwarder := $f;
     }
 
-    my $archetypes := Perl6::Metamodel::Archetypes.new( :nominal(1), :inheritable(1) );
+    my $archetypes := Perl6::Metamodel::Archetypes.new(
+        :nominal(1), :inheritable(1), :augmentable(1) );
     method archetypes() {
         $archetypes
     }

diff --git a/src/core/Exception.pm b/src/core/Exception.pm
@@ -738,9 +738,9 @@ my class X::Syntax::Augment::WithoutMonkeyTyping does X::Syntax {
     method message() { "augment not allowed without 'use MONKEY_TYPING'" };
 }
 
-my class X::Syntax::Augment::Role does X::Syntax {
-    has $.role-name;
-    method message() { "Cannot augment role $.role-name, since roles are immutable" };
+my class X::Syntax::Augment::Illegal does X::Syntax {
+    has $.package;
+    method message() { "Cannot augment $.package because it is closed" };
 }
 
 my class X::Syntax::Argument::MOPMacro does X::Syntax {