[svn:parrot] r36096 - trunk/languages/perl6/src/parser

Author: jonathan
Date: Wed Jan 28 07:54:20 2009
New Revision: 36096

Modified:
   trunk/languages/perl6/src/parser/actions.pm
   trunk/languages/perl6/src/parser/methods.pir

Log:
[rakudo] Compile time detection of type re-declaration, as well as making class A is B { } and class A does B { } a compile time error when B is not declared.

Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm	(original)
+++ trunk/languages/perl6/src/parser/actions.pm	Wed Jan 28 07:54:20 2009
@@ -588,11 +588,15 @@
 
     my $name := ~$<name>[0];
     if $name {
-        # It's a named enumeration. First, we will get a mapping of all the names
-        # we will introduce with this enumeration to their values. We'll compute
-        # these at compile time, so then we can build as much of the enum as possible
-        # as PAST at compile time too. Note that means that, like a BEGIN block, we
-        # will compile, run and get the return value now.
+        # It's a named enumeration. Ensure the type isn't already declared.
+        if $/.type_redaclaration() {
+            $/.panic("Re-declaration of type " ~ $name);
+        }
+        
+        # Get a mapping of all the names we will introduce with this enumeration to their
+        # values. We'll compute these at compile time, so then we can build as much of the
+        # enum as possible as PAST at compile time too. Note that means that, like a
+        # BEGIN block, we will compile, run and get the return value now.
         my $block := PAST::Block.new(
             :blocktype('declaration'),
             PAST::Stmts.new(
@@ -1615,6 +1619,13 @@
             my $trait := $( $_ );
             if $trait[1] eq 'also' { $block<isalso> := 1; }
             else {
+                ##  If it is a trait_auxiliary:does or a trait_auxiliary:is we
+                ##  should check the name is a type.
+                if $trait[0] eq 'trait_auxiliary:is' || $trait[0] eq 'trait_auxiliary:does' {
+                    unless $/.is_type($trait[1]) {
+                        $_.panic("The type " ~ $trait[1] ~ " does not exist.");
+                    }
+                }
                 $trait.name('!meta_trait');
                 $trait.unshift($?METACLASS);
                 $init.push($trait);
@@ -1622,6 +1633,14 @@
         }
     }
 
+    #  If it's not an "is also", have a name and aren't a role (since they can
+    #  have many declarations) we need to check it's not a duplicate.
+    if !$block<isalso> && $<module_name> && $?PKGDECL ne 'role' {
+        if $/.type_redaclaration() {
+            $/.panic("Re-declaration of type " ~ ~$<module_name>[0]);
+        }
+    }
+
     #  At the beginning, create the "class/module/grammar/role/etc"
     #  metaclass handle on which we do the other operations.
     $init.unshift(
@@ -2507,6 +2526,11 @@
 
 
 method type_declarator($/) {
+    # Make sure it's not a re-declaration.
+    if $/.type_redaclaration() {
+        $/.panic("Re-declaration of type " ~ ~$<name>);
+    }
+
     # We need a block containing the constraint condition.
     my $past := $( $<EXPR> );
     if (!$past.isa(PAST::Block) || $past.compiler() eq 'PGE::Perl6Regex') {

Modified: trunk/languages/perl6/src/parser/methods.pir
==============================================================================
--- trunk/languages/perl6/src/parser/methods.pir	(original)
+++ trunk/languages/perl6/src/parser/methods.pir	Wed Jan 28 07:54:20 2009
@@ -27,9 +27,10 @@
     ns = $P0.'parse_name'(name)
     short_name = pop ns
 
-    # Check if the symbol already exists in the NS; if so we're done.
+    # Check if the symbol already exists in the NS; if so we record it as
+    # an existing type.
     $P0 = get_hll_global ns, short_name
-    unless null $P0 goto done
+    unless null $P0 goto type_exists
 
     # Work outwards to find a block defining a package and put the type
     # there. XXX This makes it too visible for lexical types, but if we
@@ -45,22 +46,33 @@
     if null $P0 goto it_loop
     if $P0 == '' goto it_loop
   it_loop_end:
+    $P0 = cur_block.'symbol'(name)
+    if $P0 goto type_exists
     cur_block.'symbol'(name, 'does_abstraction'=>1)
 
     # We also need to register it under it's fully qualified name at the outermost
     # block.
+    .local pmc bottom_block
+    $I0 = elements blocks
+    dec $I0
+    bottom_block = blocks[$I0]
     $P0 = get_hll_global ['Perl6';'Grammar';'Actions'], '@?NS'
     unless $P0 goto no_ns
     $S0 = $P0[0]
     concat $S0, '::'
     name = concat $S0, name
+    $P0 = bottom_block.'symbol'(name)
+    if $P0 goto type_exists
   no_ns:
-    $I0 = elements blocks
-    dec $I0
-    $P0 = blocks[$I0]
-    $P0.'symbol'(name, 'does_abstraction'=>1)
+    bottom_block.'symbol'(name, 'does_abstraction'=>1)
 
-  done:
+    # Record that a type was added or already existed.
+    $P0 = box 0
+    goto set_redecl
+  type_exists:
+    $P0 = box 1
+  set_redecl:
+    setprop self, '$!type_redecl', $P0
 .end
 
 
@@ -129,6 +141,18 @@
         .return (0)
 .end
 
+
+=item type_redeclaration
+
+Checks if the most recently added type was a re-declaration.
+
+=cut
+
+.sub 'type_redaclaration' :method
+    $P0 = getprop '$!type_redecl', self
+    .return ($P0)
+.end
+
 =back
 
 =cut