Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Merge branch 'master' of git@github.com:rakudo/rakudo
  • Loading branch information
colomon committed Mar 26, 2010
2 parents 26ba8bf + e8b8da3 commit 208fcab
Show file tree
Hide file tree
Showing 3 changed files with 45 additions and 29 deletions.
20 changes: 12 additions & 8 deletions src/Perl6/Actions.pm
Expand Up @@ -823,13 +823,17 @@ sub declare_variable($/, $past, $sigil, $twigil, $desigilname, $trait_list) {
# Find the current package and add the attribute.
my $attrname := ~$sigil ~ '!' ~ $desigilname;
our @PACKAGE;
unless +@PACKAGE { $/.CURSOR.panic("Can not declare attribute outside of a package"); }
my %attr_table := @PACKAGE[0].attributes;
if %attr_table{$attrname} { $/.CURSOR.panic("Can not re-declare attribute " ~ $attrname); }
%attr_table{$attrname} := Q:PIR { %r = root_new ['parrot';'Hash'] };
%attr_table{$attrname}<name> := $attrname;
%attr_table{$attrname}<accessor> := $twigil eq '.' ?? 1 !! 0;
%attr_table{$attrname}<rw> := $trait_list && has_compiler_trait_with_val($trait_list, '&trait_mod:<is>', 'rw') ?? 1 !! 0;
unless +@PACKAGE {
$/.CURSOR.panic("Can not declare an attribute outside of a package");
}
if @PACKAGE[0].has_attribute($attrname) {
$/.CURSOR.panic("Can not re-declare attribute " ~ $attrname);
}
my %attr_info;
%attr_info<name> := $attrname;
%attr_info<accessor> := $twigil eq '.' ?? 1 !! 0;
%attr_info<rw> := $trait_list && has_compiler_trait_with_val($trait_list, '&trait_mod:<is>', 'rw') ?? 1 !! 0;
@PACKAGE[0].attributes.push(%attr_info);

# If no twigil, note $foo is an alias to $!foo.
if $twigil eq '' {
Expand All @@ -839,7 +843,7 @@ sub declare_variable($/, $past, $sigil, $twigil, $desigilname, $trait_list) {
# Nothing to emit here; just hand back an empty node, but also
# annotate it with the attribute table.
$past := PAST::Stmts.new( );
$past<attribute_data> := %attr_table{$attrname};
$past<attribute_data> := %attr_info;
}
else {
# Not an attribute - need to emit delcaration here.
Expand Down
36 changes: 24 additions & 12 deletions src/Perl6/Compiler/Package.pm
Expand Up @@ -18,7 +18,7 @@ has $!methods;
# Table of methods we're adding to the meta model
has $!meta_methods;

# Table of attributes meta-data hashes. Maps name to hash.
# List attributes meta-data hashes. Should be Attribute class instances one day.
has $!attributes;

# List of traits.
Expand Down Expand Up @@ -63,12 +63,24 @@ method meta_methods() {
$!meta_methods
}
# Accessor for attributes hash.
# Accessor for attributes list.
method attributes() {
unless $!attributes { $!attributes := Q:PIR { %r = root_new ['parrot';'Hash'] } }
unless $!attributes { $!attributes := PAST::Node.new() }
$!attributes
}

# Checks if there is already an attribute with the given name.
method has_attribute($name) {
if $!attributes {
for @($!attributes) {
if $_<name> eq $name {
return 1;
}
}
}
0
}

# Accessor for traits list.
method traits() {
unless $!traits { $!traits := PAST::Node.new() }
Expand Down Expand Up @@ -146,19 +158,19 @@ method finish($block) {
}

# Attributes.
my %attrs := $!attributes;
for %attrs {
my $attr_list := self.attributes();
for @($attr_list) {
my $attr := PAST::Op.new(
:pasttype('callmethod'),
:name('new'),
PAST::Var.new( :name('Attribute'), :namespace(''), :scope('package') ),
PAST::Val.new( :value(~$_), :named('name') ),
PAST::Val.new( :value(%attrs{$_}<accessor>), :named('has_accessor') ),
PAST::Val.new( :value(%attrs{$_}<rw>), :named('rw') )
PAST::Var.new( :name('Attribute'), :namespace(''), :scope('package') ),
PAST::Val.new( :value($_<name>), :named('name') ),
PAST::Val.new( :value($_<accessor>), :named('has_accessor') ),
PAST::Val.new( :value($_<rw>), :named('rw') )
);
if %attrs{$_}<build> {
%attrs{$_}<build>.named('build');
$attr.push(%attrs{$_}<build>);
if $_<build> {
$_<build>.named('build');
$attr.push($_<build>);
}
$decl.push(PAST::Op.new(
:pasttype('callmethod'),
Expand Down
18 changes: 9 additions & 9 deletions src/Perl6/Compiler/Role.pm
Expand Up @@ -77,19 +77,19 @@ method finish($block) {
}

# Attributes.
my %attrs := self.attributes;
for %attrs {
my $attr_list := self.attributes();
for @($attr_list) {
my $attr := PAST::Op.new(
:pasttype('callmethod'),
:name('new'),
PAST::Var.new( :name('Attribute'), :namespace(''), :scope('package') ),
PAST::Val.new( :value(~$_), :named('name') ),
PAST::Val.new( :value(%attrs{$_}<accessor>), :named('has_accessor') ),
PAST::Val.new( :value(%attrs{$_}<rw>), :named('rw') ),
PAST::Var.new( :name('Attribute'), :namespace(''), :scope('package') ),
PAST::Val.new( :value($_<name>), :named('name') ),
PAST::Val.new( :value($_<accessor>), :named('has_accessor') ),
PAST::Val.new( :value($_<rw>), :named('rw') )
);
if %attrs{$_}<build> {
%attrs{$_}<build>.named('build');
$attr.push(%attrs{$_}<build>);
if $_<build> {
$_<build>.named('build');
$attr.push($_<build>);
}
$decl.push(PAST::Op.new(
:pasttype('callmethod'),
Expand Down

0 comments on commit 208fcab

Please sign in to comment.