Skip to content

Commit

Permalink
* Op.pm is now using MooseX::Declare syntax.
Browse files Browse the repository at this point in the history
  • Loading branch information
Audrey Tang committed Jul 20, 2010
1 parent b6fa476 commit 12fb896
Show file tree
Hide file tree
Showing 2 changed files with 39 additions and 177 deletions.
214 changes: 38 additions & 176 deletions Op.pm
View file
@@ -1,166 +1,98 @@
use strict;
use warnings;
use 5.010;
use MooseX::Declare;

use CgOp;

{
package Op;
use Moose;

sub paren { shift }

__PACKAGE__->meta->make_immutable;
no Moose;
class Op {
method paren { $self }
}

{
package Op::NIL;
use Moose;
extends 'Op';

class Op::NIL extends Op {
has ops => (isa => 'ArrayRef', is => 'ro', required => 1);

sub code {
my ($self, $body) = @_;
method code ($body) {
CgOp::nil(map { blessed $_ ? $_->code($body) : $_ } @{ $self->ops });
}

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

{
package Op::CgOp;
use Moose;
extends 'Op';

class Op::CgOp extends Op {
has op => (is => 'ro', required => 1);

sub code { $_[0]->op }

__PACKAGE__->meta->make_immutable;
no Moose;
method code { $self->op }
}

{
package Op::StatementList;
use Moose;
extends 'Op';

class Op::StatementList extends Op {
has children => (isa => 'ArrayRef[Op]', is => 'ro', required => 1);

sub code {
my ($self, $body) = @_;
method code ($body) {
my @ch = map { $_->code($body) } @{ $self->children };
# XXX should be Nil or something
my $end = @ch ? pop(@ch) : CgOp::wrap(CgOp::null('object'));

CgOp::prog((map { CgOp::sink($_) } @ch), $end);
}

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

{
package Op::CallSub;
use Moose;
extends 'Op';

class Op::CallSub extends Op {
has invocant => (isa => 'Op', is => 'ro', required => 1);
has positionals => (isa => 'ArrayRef[Op]', is => 'ro',
default => sub { [] });
# non-parenthesized constructor
has splittable_pair => (isa => 'Bool', is => 'rw', default => 0);
has splittable_parcel => (isa => 'Bool', is => 'rw', default => 0);

sub paren {
my ($self) = @_;
method paren () {
Op::CallSub->new(invocant => $self->invocant,
positionals => $self->positionals);
}

sub code {
my ($self, $body) = @_;
method code ($body) {
CgOp::subcall(CgOp::fetch($self->invocant->code($body)),
map { $_->code($body) } @{ $self->positionals });
}

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

{
package Op::CallMethod;
use Moose;
extends 'Op';

class Op::CallMethod extends Op {
has receiver => (isa => 'Op', is => 'ro', required => 1);
has positionals => (isa => 'ArrayRef[Op]', is => 'ro',
default => sub { [] });
has name => (isa => 'Str', is => 'ro', required => 1);

sub code {
my ($self, $body) = @_;
method code ($body) {
CgOp::methodcall($self->receiver->code($body),
$self->name, map { $_->code($body) } @{ $self->positionals });
}

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

{
package Op::GetSlot;
use Moose;
extends 'Op';

class Op::GetSlot extends Op {
has object => (isa => 'Op', is => 'ro', required => 1);
has name => (isa => 'Str', is => 'ro', required => 1);

sub code {
my ($self, $body) = @_;
method code ($body) {
CgOp::varattr($self->name, CgOp::fetch($self->object->code($body)));
}

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

# or maybe we should provide Op::Let and let Actions do the desugaring?
{
package Op::CallMetaMethod;
use Moose;
extends 'Op';

class Op::CallMetaMethod extends Op {
has receiver => (isa => 'Op', is => 'ro', required => 1);
has positionals => (isa => 'ArrayRef[Op]', is => 'ro',
default => sub { [] });
has name => (isa => 'Str', is => 'ro', required => 1);

sub code {
my ($self, $body) = @_;
method code ($body) {
CgOp::let($self->receiver->code($body), 'Variable', sub {
CgOp::methodcall(CgOp::newscalar(CgOp::how(CgOp::fetch($_[0]))),
$self->name, $_[0], map { $_->code($body) }
@{ $self->positionals })});
}

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

{
package Op::Interrogative;
use Moose;
extends 'Op';

class Op::Interrogative extends Op {
has receiver => (isa => 'Op', is => 'ro', required => 1);
has name => (isa => 'Str', is => 'ro', required => 1);

sub code {
my ($self, $body) = @_;
method code ($body) {
my $c = CgOp::fetch($self->receiver->code($body));
given ($self->name) {
when ("HOW") {
Expand All @@ -176,20 +108,12 @@ use CgOp;
}
CgOp::newscalar($c);
}

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

{
package Op::Yada;
use Moose;
extends 'Op';

class Op::Yada extends Op {
has kind => (isa => 'Str', is => 'ro', required => 1);

sub code {
my ($self, $cg, $body) = @_;
method code ($body) {

CgOp::prog(
CgOp::subcall(
Expand All @@ -203,11 +127,7 @@ use CgOp;
}
}

{
package Op::ShortCircuit;
use Moose;
extends 'Op';

class Op::ShortCircuit extends Op {
has kind => (isa => 'Str', is => 'ro', required => 1);
has args => (isa => 'ArrayRef', is => 'ro', required => 1);

Expand Down Expand Up @@ -236,8 +156,7 @@ use CgOp;
}
}

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

my @r = reverse @{ $self->args };
my $acc = (shift @r)->code($body);
Expand All @@ -251,33 +170,20 @@ use CgOp;
}
}

{
package Op::StringLiteral;
use Moose;
extends 'Op';

class Op::StringLiteral extends Op {
has text => (isa => 'Str', is => 'ro', required => 1);

sub code {
my ($self, $body) = @_;
method code ($body) {
CgOp::string_var($self->text);
}

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

{
package Op::Conditional;
use Moose;
extends 'Op';

class Op::Conditional extends Op {
has check => (isa => 'Op', is => 'ro', required => 1);
has true => (isa => 'Maybe[Op]', is => 'ro', required => 1);
has false => (isa => 'Maybe[Op]', is => 'ro', required => 1);

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

CgOp::ternary(
CgOp::unbox('Boolean',
Expand All @@ -289,24 +195,15 @@ use CgOp;
($self->false ? $self->false->code($body) :
CgOp::null('Variable')));
}

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

{
package Op::WhileLoop;
use Moose;
extends 'Op';

class Op::WhileLoop extends Op {
has check => (isa => 'Op', is => 'ro', required => 1);
has body => (isa => 'Op', is => 'ro', required => 1);
has once => (isa => 'Bool', is => 'ro', required => 1);
has until => (isa => 'Bool', is => 'ro', required => 1);

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

method code ($body) {
CgOp::prog(
CgOp::whileloop($self->until, $self->once,
CgOp::unbox('Boolean',
Expand All @@ -315,23 +212,15 @@ use CgOp;
CgOp::sink($self->body->code($body))),
CgOp::null('Variable'));
}

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

# only for state $x will start and START{} in void context, yet
{
package Op::Start;
use Moose;
extends 'Op';

class Op::Start extends Op {
# possibly should use a raw boolean somehow
has condvar => (isa => 'Str', is => 'ro', required => 1);
has body => (isa => 'Op', is => 'ro', required => 1);

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

CgOp::ternary(
CgOp::unbox('Boolean',
Expand All @@ -343,68 +232,41 @@ use CgOp;
CgOp::box('Bool', CgOp::bool(1))),
$self->body->code($body)));
}

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


{
package Op::Num;
use Moose;
extends 'Op';

class Op::Num extends Op {
has value => (isa => 'Num', is => 'ro', required => 1);

sub code {
my ($self, $body) = @_;
method code ($body) {
CgOp::box('Num', CgOp::double($self->value));
}

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

{
package Op::Bind;
use Moose;
extends 'Op';

class Op::Bind extends Op {
has lhs => (isa => 'Op', is => 'ro', required => 1);
has rhs => (isa => 'Op', is => 'ro', required => 1);
has readonly => (isa => 'Bool', is => 'ro', required => 1);

sub code {
my ($self, $body) = @_;
method code ($body) {
CgOp::prog(
CgOp::bind($self->readonly, $self->lhs->code($body),
$self->rhs->code($body)),
CgOp::null('Variable'));
}

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

{
package Op::Lexical;
use Moose;
extends 'Op';

class Op::Lexical extends Op {
has name => (isa => 'Str', is => 'ro', required => 1);
has state_decl => (isa => 'Bool', is => 'ro', default => 0);

sub paren {
Op::Lexical->new(name => shift()->name);
}

sub code {
my ($self, $body) = @_;
method code ($body) {
CgOp::scopedlex($self->name);
}

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

1;

0 comments on commit 12fb896

Please sign in to comment.