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

[jonathan]

Author: jonathan
Date: Sat Jan 19 15:04:10 2008
New Revision: 25003

Modified:
   trunk/languages/perl6/src/parser/actions.pm
   trunk/languages/perl6/src/parser/grammar.pg

Log:
[perl6] Do the initial work to implement classes with methods.

Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm (original)
+++ trunk/languages/perl6/src/parser/actions.pm Sat Jan 19 15:04:10 2008
@@ -299,12 +299,19 @@
 
 
 method routine_declarator($/, $key) {
-    if ($key eq 'sub') {
+    if $key eq 'sub' {
         my $past := $($<routine_def>);
         $past.blocktype('declaration');
         $past.node($/);
         make $past;
     }
+    elsif $key eq 'method' {
+        my $past := $($<method_def>);
+        $past.blocktype('declaration');
+        $past.pirflags(':method');
+        $past.node($/);
+        make $past;
+    }
 }
 
 
@@ -318,6 +325,13 @@
     make $past;
 }
 
+method method_def($/) {
+    my $past := $( $<block> );
+    if $<ident> {
+        $past.name( ~$<ident>[0] );
+    }
+    make $past;
+}
 
 method signature($/) {
     my $params := PAST::Stmts.new( :node($/) );
@@ -440,9 +454,33 @@
 
 method package_declarator($/, $key) {
     my $past := $( $/{$key} );
-    $past.namespace($<name><ident>);
-    $past.blocktype('declaration');
-    $past.pirflags(':init :load');
+    if $<sym> eq 'class' {
+        # Declare the namespace and that this is something we do
+        # "on load".
+        $past.namespace($<name><ident>);
+        $past.blocktype('declaration');
+        $past.pirflags(':init :load');
+
+        # Set it as the current class. XXX need array to support nested classes
+        our $?CLASS;
+        $?CLASS := $past;
+
+        # We'll create a new statement list where we'll store the class
+        # declaration code.
+        my $decl_past := PAST::Stmts.new();
+        $past.unshift($decl_past);
+        
+        # Code to create the class.
+        my $pir := "    $P0 = subclass 'Perl6Object', '" ~ $<name> ~ "'\n" ~
+                   "    $P1 = get_hll_global ['Perl6Object'], 'make_proto'\n" ~
+                   "    $P1($P0, '" ~ $<name> ~ "')\n";
+        $decl_past.push(PAST::Op.new( :inline($pir) ));
+    }
+    else {
+        $past.namespace($<name><ident>);
+        $past.blocktype('declaration');
+        $past.pirflags(':init :load');
+    }
     make $past;
 }
 

Modified: trunk/languages/perl6/src/parser/grammar.pg
==============================================================================
--- trunk/languages/perl6/src/parser/grammar.pg (original)
+++ trunk/languages/perl6/src/parser/grammar.pg Sat Jan 19 15:04:10 2008
@@ -290,7 +290,7 @@
 
 token routine_declarator {
     | $<sym>='sub' <routine_def> {*}             #= sub
-    # | $<sym>='method' <method_def> {*}         #= method
+    | $<sym>='method' <method_def> {*}           #= method
 }
 
 rule routine_def {
@@ -299,6 +299,12 @@
     {*}
 }
 
+rule method_def {
+    <ident>? <multisig>?
+    <block>
+    {*}
+}
+
 rule multisig {
     '(' <signature> ')'
 }
@@ -383,7 +389,7 @@
 
 
 rule package_declarator {
-    $<sym>=[module]
+    $<sym>=[module|class]
     <name>
     [
     || ';' <statement_block> {*}                 #= statement_block