Permalink
Browse files

Refactor handling of attributes and methods in backend

  • Loading branch information...
1 parent 75090a8 commit 0e836f62bb383008abe8955513a9c43b1128c1f0 @sorear committed Dec 28, 2010
Showing with 178 additions and 121 deletions.
  1. +143 −104 lib/CLRBackend.cs
  2. +23 −10 src/Metamodel.pm
  3. +12 −7 src/NAMBackend.pm
View
Oops, something went wrong.
View
@@ -271,7 +271,7 @@ our %units;
use Moose;
extends 'Metamodel::Module';
- has attributes => (isa => 'ArrayRef[Str]', is => 'ro',
+ has attributes => (isa => 'ArrayRef[Metamodel::Attribute]', is => 'ro',
default => sub { [] });
has methods => (isa => 'ArrayRef[Metamodel::Method]', is => 'ro',
default => sub { [] });
@@ -282,7 +282,7 @@ our %units;
sub add_attribute {
my ($self, $name) = @_;
- push @{ $self->attributes }, $name;
+ push @{ $self->attributes }, Metamodel::Attribute->new(name => $name);
}
sub add_method {
@@ -360,7 +360,7 @@ our %units;
use Moose;
extends 'Metamodel::Module';
- has attributes => (isa => 'ArrayRef[Str]', is => 'ro',
+ has attributes => (isa => 'ArrayRef[Metamodel::Attribute]', is => 'ro',
default => sub { [] });
has methods => (isa => 'ArrayRef[Metamodel::Method]', is => 'ro',
default => sub { [] });
@@ -369,7 +369,7 @@ our %units;
sub add_attribute {
my ($self, $name) = @_;
- push @{ $self->attributes }, $name;
+ push @{ $self->attributes }, Metamodel::Attribute->new(name => $name);
}
sub add_method {
@@ -396,21 +396,22 @@ our %units;
use Moose;
extends 'Metamodel::Module';
- has attributes => (isa => 'ArrayRef[Str]', is => 'ro',
+ has attributes => (isa => 'ArrayRef[Metamodel::Attribute]', is => 'ro',
default => sub { [] });
- has methods => (isa => 'ArrayRef', is => 'ro',
+ has methods => (isa => 'ArrayRef[Metamodel::Method]', is => 'ro',
default => sub { [] });
has superclasses => (isa => 'ArrayRef', is => 'ro',
default => sub { [] });
sub add_attribute {
my ($self, $name) = @_;
- push @{ $self->attributes }, $name;
+ push @{ $self->attributes }, Metamodel::Attribute->new(name => $name);
}
sub add_method {
my ($self, $kind, $name, $var, $body) = @_;
- push @{ $self->methods }, [ $name, $var, $kind ];
+ push @{ $self->methods }, Metamodel::Method->new(name => $name,
+ var => $var, kind => $kind);
}
sub add_super {
@@ -439,10 +440,22 @@ our %units;
package Metamodel::Method;
use Moose;
- has name => (isa => 'Str', is => 'ro', required => 1);
+ # normally a Str, but may be Op for param roles
+ has name => (is => 'ro', required => 1);
# normal, private, meta, sub
has kind => (isa => 'Str', is => 'ro', required => 1);
- has body => (is => 'ro', required => 1);
+ has var => (isa => 'Str', is => 'ro');
+ has body => (isa => 'ArrayRef', is => 'ro');
+
+ no Moose;
+ __PACKAGE__->meta->make_immutable;
+}
+
+{
+ package Metamodel::Attribute;
+ use Moose;
+
+ has name => (isa => 'Str', is => 'ro', required => 1);
no Moose;
__PACKAGE__->meta->make_immutable;
View
@@ -29,8 +29,8 @@ sub nam_sub {
$s->{nam} = $s->code->cgop($s);
if ($s->parametric_role_hack) {
for (@{ $unit->deref($s->parametric_role_hack)->methods }) {
- if (ref $_->[0]) {
- $_->[0] = $_->[0]->cgop($s)->to_nam;
+ if (ref $_->name) {
+ $_->{name} = $_->name->cgop($s)->to_nam;
}
}
}
@@ -60,6 +60,7 @@ sub Metamodel::StaticSub::to_nam {
$flags |= 16 if $self->returnable;
$flags |= 32 if $self->augmenting;
[
+ 'sub',
$self->name,
$self->{outer}, # get the raw xref
$flags,
@@ -93,7 +94,7 @@ sub Metamodel::Package::to_nam {
sub Metamodel::Class::to_nam {
my $self = shift;
$self->Metamodel::Package::to_nam(
- $self->attributes,
+ [ map { $_->to_nam } @{ $self->attributes } ],
[ map { $_->to_nam } @{ $self->methods } ],
$self->superclasses,
$self->linearized_mro,
@@ -103,7 +104,7 @@ sub Metamodel::Class::to_nam {
sub Metamodel::Role::to_nam {
my $self = shift;
$self->Metamodel::Package::to_nam(
- $self->attributes,
+ [ map { $_->to_nam } @{ $self->attributes } ],
[ map { $_->to_nam } @{ $self->methods } ],
$self->superclasses,
);
@@ -112,14 +113,18 @@ sub Metamodel::Role::to_nam {
sub Metamodel::ParametricRole::to_nam {
my $self = shift;
$self->Metamodel::Package::to_nam(
- $self->attributes,
- $self->methods,
+ [ map { $_->to_nam } @{ $self->attributes } ],
+ [ map { $_->to_nam } @{ $self->methods } ],
$self->superclasses,
);
}
sub Metamodel::Method::to_nam {
- [ $_[0]->name, $_[0]->kind, $_[0]->body ]
+ [ $_[0]->name, $_[0]->kind, $_[0]->var, $_[0]->body ]
+}
+
+sub Metamodel::Attribute::to_nam {
+ [ $_[0]->name ]
}
sub Sig::Parameter::to_nam {

0 comments on commit 0e836f6

Please sign in to comment.