Author: pmichaud
Date: Thu Jan 1 10:37:19 2009
New Revision: 34754
Modified:
branches/rvar/languages/perl6/perl6.pir
branches/rvar/languages/perl6/src/builtins/guts.pir
branches/rvar/languages/perl6/src/parser/actions.pm
branches/rvar/languages/perl6/src/parser/grammar.pg
Log:
[rakudo]: Refactor of basic class creation and inheritance.
Modified: branches/rvar/languages/perl6/perl6.pir
==============================================================================
--- branches/rvar/languages/perl6/perl6.pir (original)
+++ branches/rvar/languages/perl6/perl6.pir Thu Jan 1 10:37:19 2009
@@ -88,7 +88,7 @@
setattribute perl6, '$version', $P0
## create a list for holding the stack of nested blocks
- $P0 = new 'List'
+ $P0 = new ['List']
set_hll_global ['Perl6';'Grammar';'Actions'], '@?BLOCK', $P0
## create a list for holding the stack of nested packages
@@ -96,23 +96,10 @@
$P0 = new 'List'
set_hll_global ['Perl6';'Grammar';'Actions'], '@?PACKAGE', $P0
- ## create a list for holding the stack of nested modules
- ## (that may be roles, classes or grammars).
- $P0 = new 'List'
- set_hll_global ['Perl6';'Grammar';'Actions'], '@?MODULE', $P0
-
- ## create a list for holding the stack of nested classes
- ## (that may be classes or grammars).
- $P0 = new 'List'
- set_hll_global ['Perl6';'Grammar';'Actions'], '@?CLASS', $P0
-
- ## create a list for holding the stack of nested roles
- $P0 = new 'List'
- set_hll_global ['Perl6';'Grammar';'Actions'], '@?ROLE', $P0
-
- ## create a list for holding the stack of nested grammars
+ ## create a list for holding the stack of nested package
+ ## declarators
$P0 = new 'List'
- set_hll_global ['Perl6';'Grammar';'Actions'], '@?GRAMMAR', $P0
+ set_hll_global ['Perl6';'Grammar';'Actions'], '@?PKGDECL', $P0
## create a list of END blocks to be run
$P0 = new 'List'
Modified: branches/rvar/languages/perl6/src/builtins/guts.pir
==============================================================================
--- branches/rvar/languages/perl6/src/builtins/guts.pir (original)
+++ branches/rvar/languages/perl6/src/builtins/guts.pir Thu Jan 1 10:37:19 2009
@@ -366,6 +366,63 @@
.end
+=item !class_create(type, name)
+
+Create a metaclass object for C<type> with the given C<name>.
+This simply creates a handle on which we can hang methods, attributes,
+traits, etc. -- the class itself isn't created until the class
+is composed (see C<!class_compose> below).
+
+=cut
+
+.sub '!class_create'
+ .param string type
+ .param string name
+
+ .local pmc metaclass
+ metaclass = newclass name
+ .return (metaclass)
+.end
+
+
+=item !class_compose(Class metaclass)
+
+Compose the class. This includes resolving any inconsistencies
+and creating the protoobjects.
+
+=cut
+
+.sub '!class_compose' :multi(['Class'])
+ .param pmc metaclass
+ .local pmc p6meta
+ p6meta = get_hll_global ['Perl6Object'], '$!P6META'
+
+ p6meta.'register'(metaclass, 'parent'=>'Any')
+.end
+
+
+=item !class_trait(metaclass, type, name)
+
+Add a trait with the given C<type> and C<name> to C<metaclass>.
+
+=cut
+
+.sub '!class_trait'
+ .param pmc metaclass
+ .param string type
+ .param string name
+
+ ## get the (parrot)class object associated with name
+ $P0 = compreg 'Perl6'
+ $P0 = $P0.'parse_name'(name)
+ $P0 = get_hll_namespace $P0
+ $P0 = get_class $P0
+
+ ## add it as parent to metaclass
+ metaclass.'add_parent'($P0)
+.end
+
+
=item !keyword_class(name)
Internal helper method to create a class.
Modified: branches/rvar/languages/perl6/src/parser/actions.pm
==============================================================================
--- branches/rvar/languages/perl6/src/parser/actions.pm (original)
+++ branches/rvar/languages/perl6/src/parser/actions.pm Thu Jan 1 10:37:19 2009
@@ -1345,11 +1345,72 @@
method package_declarator($/, $key) {
our @?PKGDECL;
- my $sym := $<sym>;
-
+ my $sym := ~$<sym>;
+ my $past;
if $key eq 'open' {
- @?PKGDECL.push( $sym );
+ @?PKGDECL.unshift( $sym );
+ }
+ else {
+ make $( $<package_def> );
+ @?PKGDECL.shift();
+ }
+}
+
+
+method package_def($/, $key) {
+ our @?PKGDECL;
+ my $?PKGDECL := @?PKGDECL[0];
+
+ if $key eq 'panic' {
+ $/.panic("Unable to parse " ~ $?PKGDECL ~ " definition");
+ }
+
+ my $past := $( $/{$key} );
+ $past.blocktype('declaration');
+
+ if $key eq 'block' {
+ # A normal block acts like a BEGIN and is executed ASAP.
+ $past.pirflags(':load :init');
+ }
+ elsif $key eq 'statement_block' {
+ unless ~$<module_name> {
+ $/.panic("Compilation unit cannot be anonymous");
+ }
+ }
+ # Create a node at the beginning of the block's initializer
+ # for package initializations
+ my $init := PAST::Stmts.new();
+ $past[0].unshift( $init );
+
+ # At the beginning, create the "class/module/grammar/role/etc"
+ # metaclass handle on which we do the other operations.
+ $init.unshift(
+ PAST::Op.new( :pasttype('bind'),
+ PAST::Var.new( :name('metaclass'), :scope('register'), :isdecl(1)
),
+ PAST::Op.new( :name('!class_create'), $?PKGDECL,
~$<module_name>[0])
+ )
+ );
+
+ # Add any traits coming from the package declarator.
+ # Traits in the body have already been added to the block.
+ my $metaclass := PAST::Var.new( :name('metaclass'), :scope('register') );
+ if $<trait> {
+ for @($<trait>) {
+ # Trait nodes come in as PAST::Op( :name('list') ).
+ # We just modify them to call !class_trait and add
+ # the metaclass as the first argument.
+ my $trait := $( $_ );
+ $trait.name('!class_trait');
+ $trait.unshift($metaclass);
+ $init.push($trait);
+ }
}
+
+ # ...and at the end of the block's initializer, we finalize any
+ # composition that occurred.
+ $past[0].push( PAST::Op.new( :name('!class_compose'), $metaclass) );
+
+ make $past;
}
Modified: branches/rvar/languages/perl6/src/parser/grammar.pg
==============================================================================
--- branches/rvar/languages/perl6/src/parser/grammar.pg (original)
+++ branches/rvar/languages/perl6/src/parser/grammar.pg Thu Jan 1 10:37:19 2009
@@ -615,10 +615,10 @@
]?
<trait>*
[
- | ';' <statement_block>
- | <block>
+ | ';' <statement_block> {*} #= statement_block
+ | <block> {*} #= block
+ | {*} #= panic
]
- {*}
}
