Author: pmichaud
Date: Thu Jan 1 13:31:10 2009
New Revision: 34764
Modified:
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]: More class and block refactors.
* Make sure packages get the correct namespace.
* Anonymous packages and classes are given names of '!ANON\d+' for now.
* Add simple methods and 'self'.
* Use $?BLOCK<signature> instead of $BLOCK.symbol('!signature')
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 13:31:10 2009
@@ -366,16 +366,16 @@
.end
-=item !class_create(type, name)
+=item !meta_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).
+is composed (see C<!meta_compose> below).
=cut
-.sub '!class_create'
+.sub '!meta_create'
.param string type
.param string name
@@ -385,14 +385,14 @@
.end
-=item !class_compose(Class metaclass)
+=item !meta_compose(Class metaclass)
Compose the class. This includes resolving any inconsistencies
and creating the protoobjects.
=cut
-.sub '!class_compose' :multi(['Class'])
+.sub '!meta_compose' :multi(['Class'])
.param pmc metaclass
.local pmc p6meta
p6meta = get_hll_global ['Perl6Object'], '$!P6META'
@@ -401,13 +401,13 @@
.end
-=item !class_trait(metaclass, type, name)
+=item !meta_trait(metaclass, type, name)
Add a trait with the given C<type> and C<name> to C<metaclass>.
=cut
-.sub '!class_trait'
+.sub '!meta_trait'
.param pmc metaclass
.param string type
.param string name
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 13:31:10 2009
@@ -816,6 +816,9 @@
if $key eq 'sub' {
$past := $($<routine_def>);
}
+ elsif $key eq 'method' {
+ $past := $($<method_def>);
+ }
elsif $key eq 'submethod' {
$/.panic('submethod declarations not yet implemented');
}
@@ -850,44 +853,20 @@
method method_def($/) {
my $past := $( $<block> );
- my $identifier := $<identifier>;
- if $identifier {
- $past.name( ~$identifier[0] );
- }
- $past.control('return_pir');
+ $past.blocktype('method');
- # Emit code to apply any traits.
- if $<trait> {
- for $<trait> {
- my $trait := $_;
- if $trait<trait_auxiliary> {
- my $aux := $trait<trait_auxiliary>;
- my $sym := $aux<sym>;
-
- if $sym eq 'is' {
- my $name := $aux<name>;
-
- # Emit call to trait_auxiliary:is apply trait.
- my @ns := Perl6::Compiler.parse_name( $name );
- $past.loadinit().push(
- PAST::Op.new(
- :pasttype('call'),
- :name('trait_auxiliary:is'),
- PAST::Var.new(
- :name(@ns.pop()),
- :namespace(@ns),
- :scope('package')
- ),
- PAST::Var.new(
- :name('block'), :scope('register')
- )
- )
- );
- }
- }
- }
+ if $<longname> {
+ $past.name( ~$<longname> );
}
+ # Add lexical 'self'.
+ $past[0].unshift(
+ PAST::Var.new( :name('self'), :scope('lexical'), :isdecl(1),
+ :viviself( PAST::Var.new( :name('self'), :scope('register' ) ) )
+ )
+ );
+
+ $past.control('return_pir');
make $past;
}
@@ -927,7 +906,7 @@
$?SIGNATURE := PAST::Op.new( :pasttype('stmts'), :node($/) );
$?SIGNATURE_BLOCK := PAST::Block.new( $?SIGNATURE,
:blocktype('declaration') );
- $?SIGNATURE_BLOCK.symbol( '!signature', :force(1) );
+ $?SIGNATURE_BLOCK<signature> := 1;
@?BLOCK.unshift($?SIGNATURE_BLOCK);
}
else {
@@ -1368,14 +1347,19 @@
my $past := $( $/{$key} );
$past.blocktype('declaration');
+ my $modulename := $<module_name>
+ ?? ~$<module_name>[0] !!
+ $past.unique('!ANON');
+ if ($modulename) {
+ $past.namespace( PAST::Compiler.parse_name( $modulename ) );
+ }
+
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");
- }
+ elsif $key eq 'statement_block' && !$<module_name> {
+ $/.panic("Compilation unit cannot be anonymous");
}
# Create a node at the beginning of the block's initializer
# for package initializations
@@ -1387,7 +1371,7 @@
$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])
+ PAST::Op.new( :name('!meta_create'), $?PKGDECL, $modulename )
)
);
@@ -1397,10 +1381,10 @@
if $<trait> {
for @($<trait>) {
# Trait nodes come in as PAST::Op( :name('list') ).
- # We just modify them to call !class_trait and add
+ # We just modify them to call !meta_trait and add
# the metaclass as the first argument.
my $trait := $( $_ );
- $trait.name('!class_trait');
+ $trait.name('!meta_trait');
$trait.unshift($metaclass);
$init.push($trait);
}
@@ -1408,7 +1392,7 @@
# ...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) );
+ $past[0].push( PAST::Op.new( :name('!meta_compose'), $metaclass) );
make $past;
}
@@ -1546,7 +1530,7 @@
## if twigil is ^ or :, it's a placeholder var
if $twigil eq '^' || $twigil eq ':' {
- if $?BLOCK.symbol('!signature') {
+ if $?BLOCK<signature> {
$/.panic("Cannot use placeholder var in block with
signature.");
}
unless $?BLOCK.symbol($varname) {
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 13:31:10 2009
@@ -380,8 +380,9 @@
}
rule method_def {
- <identifier>? <multisig>?
- <trait>*
+ [
+ | <longname=name> [ <multisig> | <trait> ]*
+ ]
<block>
{*}
}
