Skip to content

Commit

Permalink
TimToady says methods don't need to be cloned. Simplify accordingly.
Browse files Browse the repository at this point in the history
  • Loading branch information
sorear committed Jul 18, 2010
1 parent 0d75b53 commit 9ed2aaf
Show file tree
Hide file tree
Showing 7 changed files with 133 additions and 345 deletions.
55 changes: 0 additions & 55 deletions Body.pm
Expand Up @@ -76,59 +76,4 @@ use CgOp ();
no Moose;
}

# Like a normal body, but creates a protoobject during preinit and run!
{
package Body::Class;
use Moose;
extends 'Body';

has 'var' => (is => 'rw', isa => 'Str');
has 'super' => (is => 'ro', isa => 'ArrayRef', default => sub { [] });
has 'augmenting' => (is => 'ro', isa => 'Bool', default => 0);

sub makeproto {
my ($self) = @_;
my @p;
push @p, CgOp::lextypes('!plist', 'List<DynMetaObject>');
push @p, CgOp::lexput(0, '!plist',
CgOp::rawnew('List<DynMetaObject>'));

for my $super (@{ $self->super }) {
push @p, CgOp::rawcall(CgOp::lexget(0, '!plist'), 'Add',
CgOp::getfield('klass',
CgOp::cast('DynObject',
CgOp::fetch(CgOp::scopedlex($super)))));
}
push @p, CgOp::lexput(1, $self->var,
CgOp::methodcall(
CgOp::lexget(1, $self->var . '!HOW'), 'create-protoobject',
CgOp::wrap(CgOp::callframe),
CgOp::wrap(CgOp::lexget(0, '!plist'))));
CgOp::prog(@p);
}

around enter_code => sub {
my ($o, $self) = @_;
if ($self->mainline) {
$o->($self);
} else {
CgOp::prog(
CgOp::share_lex('!scopenum'),
$self->makeproto,
$o->($self));
}
};

around preinit_code => sub {
my ($o, $self) = @_;
$self->lexical->{'!scopenum'} = 1;
CgOp::prog(
$o->($self),
$self->makeproto);
};

__PACKAGE__->meta->make_immutable;
no Moose;
}

1;
20 changes: 4 additions & 16 deletions CodeGen.pm
Expand Up @@ -15,25 +15,15 @@ use 5.010;
slots => [f => 'Dictionary<string,Object>'] },

DynMetaObject =>
{ proto => [f => 'DynProtoMetaObject'],
BuildC3MRO => [m => 'Void'],
{ BuildC3MRO => [m => 'Void'],
typeObject => [f => 'IP6'],
outers => [f => 'List<Frame>'] },

DynProtoMetaObject =>
{ how => [f => 'IP6'],
local => [f => 'Dictionary<String,DynProtoMetaObject.Method>'],
def_outers => [f => 'List<Frame>'],
superclasses => [f => 'List<DynProtoMetaObject>'],
how => [f => 'IP6'],
local => [f => 'Dictionary<string,IP6>'],
superclasses => [f => 'List<DynMetaObject>'],
name => [f => 'String'] },

'List<Frame>' =>
{ Add => [m => 'Void'],
Count => [p => 'System.Int32'] },
'List<DynMetaObject>' =>
{ Add => [m => 'Void'] },
'List<DynProtoMetaObject>' =>
{ Add => [m => 'Void'] },
'Double' =>
{ ToString => [m => 'String'] },
'Variable' =>
Expand All @@ -51,9 +41,7 @@ use 5.010;
'Kernel.NewCaptureVar' => [m => 'Variable'],
'Console.WriteLine' => [m => 'Void'],
'String.Concat' => [m => 'String'],
'Kernel.SubPMO' => [f => 'DynProtoMetaObject'],
'Kernel.SubMO' => [f => 'DynMetaObject'],
'Kernel.ScalarPMO' => [f => 'DynProtoMetaObject'],
'Kernel.ScalarMO' => [f => 'DynMetaObject'],
'Kernel.MainlineContinuation' => [f => 'DynBlockDelegate'],
'Kernel.MakeSub' => [m => 'IP6'],
Expand Down
37 changes: 11 additions & 26 deletions Decl.pm
Expand Up @@ -192,11 +192,7 @@ use CgOp;
has var => (is => 'ro', isa => 'Str', required => 1);
has stub => (is => 'ro', isa => 'Bool', default => 0);
has parents => (is => 'ro', isa => 'ArrayRef', default => sub { [] });

# the body is a very sublike thing; it has a preinit existance, and a
# lexical scope. but instead of just a Sub, it constructs a ClassHOW at
# preinit
has body => (is => 'ro', isa => 'Body::Class');
has body => (is => 'ro', isa => 'Body');

sub used_slots {
my ($self) = @_;
Expand All @@ -217,7 +213,6 @@ use CgOp;
}

$self->body->outer($body);
$self->body->var($self->var);

CgOp::with_aux("how",
CgOp::methodcall(CgOp::scopedlex("ClassHOW"), "new",
Expand All @@ -232,30 +227,25 @@ use CgOp;

CgOp::proto_var($self->var . '!BODY',
CgOp::newscalar(
CgOp::protosub($self->body,
CgOp::proto_var('!scopenum',
CgOp::methodcall(CgOp::aux('how'),
"push-scope",
CgOp::wrap(CgOp::callframe)))))));
CgOp::protosub($self->body))),
CgOp::scopedlex($self->var,
CgOp::methodcall(CgOp::aux("how"), "create-protoobject")));
}

sub enter_code {
my ($self, $body) = @_;
CgOp::prog(
CgOp::share_lex($self->var . '!HOW'),
($self->stub ?
CgOp::share_lex($self->var) :
CgOp::share_lex($self->var),
($self->stub ? () :
($body->mainline ?
CgOp::prog(
CgOp::share_lex($self->var . '!BODY'),
CgOp::share_lex($self->var)) :
CgOp::share_lex($self->var . '!BODY') :
CgOp::clone_lex($self->var . '!BODY'))));
}

sub write {
my ($self, $body) = @_;
return unless $self->body;
$self->body->var($self->var);
$self->body->outer($body);
$self->body->write;
}
Expand All @@ -274,14 +264,13 @@ use CgOp;

sub preinit_code {
my ($self, $body) = @_;
if (!$body->isa('Body::Class')) {
if ($body->type ne 'class') {
#TODO: Make this a sorry.
die "Tried to set a method outside a class!";
}
CgOp::sink(
CgOp::methodcall(CgOp::aux("how"), "add-scoped-method",
CgOp::methodcall(CgOp::aux("how"), "add-method",
CgOp::wrap(CgOp::clr_string($self->name)),
CgOp::scopedlex('!scopenum'),
CgOp::scopedlex($self->var)));
}

Expand All @@ -298,14 +287,10 @@ use CgOp;

sub preinit_code {
my ($self, $body) = @_;
if (!$body->isa('Body::Class')) {
if ($body->type ne 'class') {
#TODO: Make this a sorry.
die "Tried to set a superclass outside a class!";
}
if ($body->augmenting) {
die "Cannot add superclasses in an augment";
die "Tried to set a superclass outside an initial class!";
}
push @{ $body->super }, $self->name;

CgOp::sink(
CgOp::methodcall(CgOp::aux('how'), "add-super",
Expand Down

0 comments on commit 9ed2aaf

Please sign in to comment.