Author: pmichaud
Date: Fri Jan 2 12:14:15 2009
New Revision: 34835
Modified:
branches/rvar/languages/perl6/perl6.pir
branches/rvar/languages/perl6/src/builtins/guts.pir
branches/rvar/languages/perl6/src/parser/actions.pm
Log:
[rakudo]: First cut at attributes in classes.
Modified: branches/rvar/languages/perl6/perl6.pir
==============================================================================
--- branches/rvar/languages/perl6/perl6.pir (original)
+++ branches/rvar/languages/perl6/perl6.pir Fri Jan 2 12:14:15 2009
@@ -101,6 +101,11 @@
$P0 = new 'List'
set_hll_global ['Perl6';'Grammar';'Actions'], '@?PKGDECL', $P0
+ ## create a (shared) metaclass node
+ $P0 = get_hll_global ['PAST'], 'Var'
+ $P0 = $P0.'new'( 'name'=>'metaclass', 'scope'=>'register' )
+ set_hll_global ['Perl6';'Grammar';'Actions'], '$?METACLASS', $P0
+
## create a list of END blocks to be run
$P0 = new 'List'
set_hll_global ['Perl6'], '@?END_BLOCKS', $P0
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 Fri Jan 2 12:14:15 2009
@@ -428,6 +428,46 @@
.end
+=item !meta_attribute(metaclass, name, itype [, 'type'=>type] )
+
+Add attribute C<name> to C<metaclass> with the given C<itype>
+and C<type>.
+
+=cut
+
+.sub '!meta_attribute'
+ .param pmc metaclass
+ .param string name
+ .param string itype
+ .param pmc attr :slurpy :named
+
+ # If the name doesn't have a twigil, we give it one.
+ $S0 = substr name, 1, 1
+ if $S0 == '!' goto have_name
+ substr name, 1, 0, '!'
+ have_name:
+
+ # Add the attribute to the metaclass.
+ metaclass.'add_attribute'(name)
+
+ # Set the itype for the attribute.
+ .local pmc attrhash, it
+ $P0 = metaclass.'attributes'()
+ attrhash = $P0[name]
+ attrhash['itype'] = itype
+
+ # and set any other attributes that came in via the slurpy hash
+ it = iter attr
+ attr_loop:
+ unless it goto attr_done
+ $S0 = shift it
+ $P0 = attr[$S0]
+ attrhash[$S0] = $P0
+ goto attr_loop
+ attr_done:
+.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 Fri Jan 2 12:14:15 2009
@@ -1374,7 +1374,7 @@
# 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') );
+ our $?METACLASS;
if $<trait> {
for @($<trait>) {
# Trait nodes come in as PAST::Op( :name('list') ).
@@ -1384,7 +1384,7 @@
if $trait[1] eq 'also' { $block<isalso> := 1; }
else {
$trait.name('!meta_trait');
- $trait.unshift($metaclass);
+ $trait.unshift($?METACLASS);
$init.push($trait);
}
}
@@ -1403,15 +1403,18 @@
# ...and at the end of the block's initializer (after any other
# items added by the block), we finalize the composition
- $block[0].push( PAST::Op.new( :name('!meta_compose'), $metaclass) );
+ $block[0].push( PAST::Op.new( :name('!meta_compose'), $?METACLASS) );
make $block;
}
method scope_declarator($/) {
- my $sym := ~$<sym>;
- my $past := $( $<scoped> );
+ my $sym := ~$<sym>;
+ my $past := $( $<scoped> );
+ my $scope := 'lexical';
+ if $sym eq 'our' { $scope := 'package'; }
+ elsif $sym eq 'has' { $scope := 'attribute'; }
if $past.isa(PAST::Var) {
$past := PAST::Op.new( $past );
@@ -1421,12 +1424,10 @@
for @($past) {
if $_.isa(PAST::Var) {
my $var := $_;
- my $scope := 'lexical';
- if $sym eq 'our' {
- $scope := 'package';
- $var.lvalue(1);
- }
-
+
+ my $type;
+ if +@($var<type>) { $type := $var<type>[0]; } # FIXME
+
# This is a variable declaration, so we set the scope in
# the block. The symbol entry also tells us the
# implementation type of the variable (itype), any
@@ -1436,22 +1437,37 @@
@?BLOCK[0].symbol( $var.name(), :scope($scope) );
$var.scope($scope);
$var.isdecl(1);
-
+ if $scope eq 'package' { $var.lvalue(1); }
my $init_value := $var.viviself();
- my $viviself := PAST::Op.new( :pirop('new PsP'), $var<itype> );
- if $init_value { $viviself.push( $init_value ); }
- $var.viviself( $viviself );
-
- if +@($var<type>) {
- $var := PAST::Op.new( :pirop('setprop'),
- $var, 'type', $var<type>[0] );
+
+ if $scope eq 'attribute' {
+ our $?METACLASS;
+ my $has := PAST::Op.new( :name('!meta_attribute'),
+ $?METACLASS, $var.name(), $var<itype> );
+ if $type { $type.named('type'); $has.push($type); }
+ if $init_value {
+ $init_value.named('init_value');
+ $has.push($init_value);
+ }
+ @?BLOCK[0].push( $has );
+ }
+ else {
+ # $scope eq 'package' | 'lexical'
+ my $viviself := PAST::Op.new( :pirop('new PsP'), $var<itype> );
+ if $init_value { $viviself.push( $init_value ); }
+ $var.viviself( $viviself );
+ if $type {
+ $var := PAST::Op.new( :pirop('setprop'),
+ $var, 'type', $type );
+ }
}
$past[$i] := $var;
}
$i++;
}
- if +@($past) == 1 { $past := $past[0]; }
- else { $past.name('infix:,'); $past.pasttype('call'); }
+ if $scope eq 'attribute' { $past := PAST::Stmts.new(); }
+ elsif +@($past) == 1 { $past := $past[0]; }
+ else { $past.name('infix:,'); $past.pasttype('call'); }
make $past;
}
@@ -1565,6 +1581,14 @@
$past.scope('package');
$past.viviself( container_itype($sigil) );
}
+
+ ## if ! twigil, it's a private attribute
+ if $twigil eq '!' {
+ $varname := $sigil ~ $twigil ~ $name;
+ $past.name($varname);
+ $past.scope('attribute');
+ $past.unshift( PAST::Var.new( :name('self'), :scope('lexical') ) );
+ }
}
elsif $key eq 'special_variable' {
$past := $( $<special_variable> );
