Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Make classes into a kind of package
  • Loading branch information
sorear committed Jul 24, 2010
1 parent c37e91c commit 1e1b8ee
Show file tree
Hide file tree
Showing 4 changed files with 51 additions and 98 deletions.
2 changes: 1 addition & 1 deletion Body.pm
Expand Up @@ -112,7 +112,7 @@ use CgOp ();
} elsif ($self->outer) {
return 1 + $self->outer->lex_level($var);
} else {
return -1;
return -1e99999;
}
}

Expand Down
103 changes: 36 additions & 67 deletions Decl.pm
Expand Up @@ -275,38 +275,54 @@ use CgOp;
has body => (is => 'ro', isa => 'Body');
has bodyvar => (is => 'ro', isa => 'Str');
has stub => (is => 'ro', isa => 'Bool', default => 0);
has name => (is => 'ro', isa => 'Str', predicate => 'has_name');

sub extra_decls { $_[0]->body ? ($_[0]->body->floated_decls) : () }
sub stashvar { $_[0]->var . '::' }
sub metavar { $_[0]->var . '!HOW' }

sub used_slots {
my ($self) = @_;
$self->var, 'Variable',
(!$self->stub ? ($self->bodyvar, 'Variable') : ());
$self->var, 'Variable', $self->stashvar, 'Variable', $self->metavar,
'Variable', (!$self->stub ? ($self->bodyvar, 'Variable') : ());
}

sub make_how { CgOp::null('Variable'); }
sub finish_obj { CgOp::noop; }

sub preinit_code {
my ($self, $body) = @_;

if ($self->stub) {
return CgOp::proto_var($self->var, CgOp::null('Variable'));
return CgOp::prog(
CgOp::proto_var($self->var, CgOp::null('Variable')),
CgOp::proto_var($self->metavar, CgOp::null('Variable')),
CgOp::proto_var($self->stashvar,
CgOp::wrap(CgOp::rawnew('Dictionary<string,Variable>'))));
}

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

CgOp::letn("pkg",
CgOp::wrap(CgOp::rawnew('Dictionary<string,Variable>')),
CgOp::letn("how", $self->make_how,
# catch usages before the closing brace
CgOp::proto_var($self->var, CgOp::null('Variable')),
CgOp::proto_var($self->var . '!HOW', CgOp::letvar("how")),
CgOp::proto_var($self->var . "::", CgOp::letvar("pkg")),

CgOp::proto_var($self->var, CgOp::letvar("pkg")),

CgOp::proto_var($self->bodyvar,
CgOp::newscalar(
CgOp::protosub($self->body))));
CgOp::proto_var($self->bodyvar,
CgOp::newscalar(
CgOp::protosub($self->body))),
$self->finish_obj));
}

sub enter_code {
my ($self, $body) = @_;
CgOp::prog(
CgOp::share_lex($self->var),
CgOp::share_lex($self->var . "::"),
CgOp::share_lex($self->var . "!HOW"),
($self->stub ? () :
($body->mainline ?
CgOp::share_lex($self->bodyvar) :
Expand Down Expand Up @@ -336,70 +352,23 @@ use CgOp;
{
package Decl::Class;
use Moose;
extends 'Decl';

has name => (is => 'ro', isa => 'Str', predicate => 'has_name');
has var => (is => 'ro', isa => 'Str', required => 1);
has bodyvar => (is => 'ro', isa => 'Str');
has stub => (is => 'ro', isa => 'Bool', default => 0);
has body => (is => 'ro', isa => 'Body');
extends 'Decl::Module';

sub extra_decls { $_[0]->body ? ($_[0]->body->floated_decls) : () }

sub used_slots {
sub make_how {
my ($self) = @_;
$self->var, 'Variable', ($self->var . '!HOW'), 'Variable',
(!$self->stub ? ($self->bodyvar, 'Variable') : ());
CgOp::methodcall(CgOp::scopedlex("ClassHOW"), "new",
CgOp::wrap(CgOp::clr_string($self->name // 'ANON')));
}

sub preinit_code {
my ($self, $body) = @_;

if ($self->stub) {
return CgOp::prog(
CgOp::proto_var($self->var . '!HOW', CgOp::null('Variable')),
CgOp::proto_var($self->var, CgOp::null('Variable')));
sub finish_obj {
my ($self) = @_;
my @r;
if (!grep { $_->isa('Decl::Super') } $self->body->do->local_decls) {
push @r, CgOp::sink(CgOp::methodcall(CgOp::letvar("how"),
"add-super", CgOp::scopedlex("Any!HOW")));
}

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

CgOp::letn("how",
CgOp::methodcall(CgOp::scopedlex("ClassHOW"), "new",
CgOp::wrap(CgOp::clr_string($self->name // 'ANON'))),

CgOp::proto_var($self->var . '!HOW', CgOp::letvar("how")),
((grep { $_->isa('Decl::Super') } $self->body->do->local_decls) ? () :
CgOp::sink(CgOp::methodcall(CgOp::letvar("how"), "add-super",
CgOp::scopedlex("Any!HOW")))),

# TODO: Initialize the protoobject to a failure here so an awesome
# error is produced if someone tries to use an incomplete class in
# a BEGIN.
CgOp::proto_var($self->var, CgOp::null('Variable')),

CgOp::proto_var($self->bodyvar,
CgOp::newscalar(
CgOp::protosub($self->body))),
CgOp::scopedlex($self->var,
CgOp::methodcall(CgOp::letvar("how"), "create-protoobject")));
}

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

sub write {
my ($self, $body) = @_;
return unless $self->body;
$self->body->outer($body);
$self->body->write;
@r, CgOp::scopedlex($self->var,
CgOp::methodcall(CgOp::letvar("how"), "create-protoobject"));
}

__PACKAGE__->meta->make_immutable;
Expand Down
36 changes: 7 additions & 29 deletions Op.pm
Expand Up @@ -419,6 +419,7 @@ use CgOp;
use Moose;
extends 'Op';

has name => (is => 'ro', isa => 'Str', predicate => 'has_name');
has var => (is => 'ro', isa => 'Str', required => 1);
has bodyvar => (is => 'ro', isa => 'Str');
has stub => (is => 'ro', isa => 'Bool', default => 0);
Expand All @@ -427,20 +428,21 @@ use CgOp;
sub decl_class { 'Decl::Package' }
sub local_decls {
my ($self) = @_;
$self->decl_class->new(stub => $self->stub, var => $self->var . "::",
$self->decl_class->new(stub => $self->stub, var => $self->var,
($self->has_name ? (name => $self->name) : ()),
($self->stub ? () : (body => $self->body,
bodyvar => $self->bodyvar)));
}

sub code {
my ($self, $body) = @_;
if ($self->stub) {
CgOp::scopedlex($self->var . "::");
CgOp::scopedlex($self->var);
} else {
CgOp::prog(
CgOp::sink(CgOp::subcall(CgOp::fetch(
CgOp::scopedlex($self->bodyvar)))),
CgOp::scopedlex($self->var . "::"));
CgOp::scopedlex($self->var));
}
}

Expand All @@ -462,33 +464,9 @@ use CgOp;
{
package Op::ClassDef;
use Moose;
extends 'Op';
extends 'Op::ModuleDef';

has name => (is => 'ro', isa => 'Str', predicate => 'has_name');
has var => (is => 'ro', isa => 'Str', required => 1);
has bodyvar => (is => 'ro', isa => 'Str');
has stub => (is => 'ro', isa => 'Bool', default => 0);
has body => (is => 'ro', isa => 'Body');

sub local_decls {
my ($self) = @_;
Decl::Class->new(stub => $self->stub, var => $self->var,
($self->has_name ? (name => $self->name) : ()),
($self->stub ? () : (body => $self->body,
bodyvar => $self->bodyvar)));
}

sub code {
my ($self, $body) = @_;
if ($self->stub) {
CgOp::scopedlex($self->var);
} else {
CgOp::prog(
CgOp::sink(CgOp::subcall(CgOp::fetch(
CgOp::scopedlex($self->bodyvar)))),
CgOp::scopedlex($self->var));
}
}
sub decl_class { 'Decl::Class' }

__PACKAGE__->meta->make_immutable;
no Moose;
Expand Down
8 changes: 7 additions & 1 deletion test.pl
Expand Up @@ -10,7 +10,7 @@ ($num)
say ("1.." ~ $num);
}

plan 96;
plan 97;

ok 1, "one is true";
ok 2, "two is also true";
Expand Down Expand Up @@ -308,4 +308,10 @@ ($num)
ok $Foo::x == 42, "can access our vars";
my module Bar { our $x = 42; }
ok $Bar::x == 42, "module accepted too";
my class Baz { our $x = 42; }
ok $Baz::x == 42, "and class";

#ok $Cow::x.notdef, "package variables autoviv to undef";
#$Cow::x = 51;
#ok $Cow::x == 51, "but can still hold values";
}

0 comments on commit 1e1b8ee

Please sign in to comment.