From 58c7a4ad1972c5ff43de0c67c21bc8e2574940b3 Mon Sep 17 00:00:00 2001 From: Audrey Tang Date: Tue, 20 Jul 2010 19:28:12 +0800 Subject: [PATCH] Revert "* Body.pm, CgOp.pm and Decl.pm are now in MooseX::Declare syntax." This reverts commit 4dc75bb3cbbf5bbece3dd779afa2c3cebf210b9f. --- Body.pm | 27 ++++++--- CgOp.pm | 72 ++++++++++++++++++++---- Decl.pm | 171 +++++++++++++++++++++++++++++++++++++++++++------------- 3 files changed, 211 insertions(+), 59 deletions(-) diff --git a/Body.pm b/Body.pm index 9c5612e1..efd04c65 100644 --- a/Body.pm +++ b/Body.pm @@ -1,9 +1,13 @@ +use strict; +use warnings; use 5.010; -use MooseX::Declare; use CodeGen (); use CgOp (); -class Body { +{ + package Body; + use Moose; + has name => (isa => 'Str', is => 'rw', default => "anon"); has do => (isa => 'Op', is => 'rw'); has enter => (isa => 'ArrayRef[Op]', is => 'ro', @@ -20,7 +24,9 @@ class Body { # also '' for incorrectly contextualized {p,x,}block, blast has type => (isa => 'Str', is => 'rw'); - method is_mainline () { + sub is_mainline { + my $self = shift; + if ($self->type && $self->type eq 'mainline') { return 1; } @@ -36,14 +42,16 @@ class Body { } } - method gen_code () { + sub gen_code { + my ($self) = @_; # TODO: Bind a return value here to catch non-ro sub use CodeGen->new(name => $self->name, body => $self, ops => CgOp::prog($self->enter_code, CgOp::return($self->do->code($self)))); } - method enter_code () { + sub enter_code { + my ($self) = @_; my @p; push @p, CgOp::lextypes(map { $_, 'Variable' } keys %{ $self->lexical }); @@ -53,14 +61,19 @@ class Body { CgOp::prog(@p); } - method write () { + sub write { + my ($self) = @_; $self->code->write; $_->write($self) for (@{ $self->decls }); } - method preinit_code () { + sub preinit_code { + my ($self) = @_; CgOp::prog(map { $_->preinit_code($self) } @{ $self->decls }); } + + __PACKAGE__->meta->make_immutable; + no Moose; } 1; diff --git a/CgOp.pm b/CgOp.pm index 3b07afbb..04dc7cac 100644 --- a/CgOp.pm +++ b/CgOp.pm @@ -1,22 +1,43 @@ use 5.010; -use MooseX::Declare; +use strict; +use warnings; + + +{ + package CgOp; + use Moose; -class CgOp { has zyg => (isa => 'ArrayRef', is => 'ro', default => sub { [] }); + + no Moose; + __PACKAGE__->meta->make_immutable; } -class CgOp::Seq extends CgOp { - method var_cg ($cg) { +{ + package CgOp::Seq; + use Moose; + extends 'CgOp'; + + sub var_cg { + my ($self, $cg) = @_; for (@{ $self->zyg }) { $_->var_cg($cg); } } + + no Moose; + __PACKAGE__->meta->make_immutable; } -class CgOp::Primitive extends CgOp { +{ + package CgOp::Primitive; + use Moose; + extends 'CgOp'; + has op => (isa => 'ArrayRef', is => 'ro', required => 1); - method var_cg ($cg) { + sub var_cg { + my ($self, $cg) = @_; for (@{ $self->zyg }) { $_->var_cg($cg); } @@ -26,10 +47,18 @@ class CgOp::Primitive extends CgOp { } $cg->$c(@o); } + + no Moose; + __PACKAGE__->meta->make_immutable; } -class CgOp::Ternary extends CgOp { - method var_cg ($cg) { +{ + package CgOp::Ternary; + use Moose; + extends 'CgOp'; + + sub var_cg { + my ($self, $cg) = @_; my ($check, $true, $false) = @{ $self->zyg }; my $l1 = $cg->label; my $l2 = $cg->label; @@ -42,13 +71,21 @@ class CgOp::Ternary extends CgOp { $false->var_cg($cg); $cg->labelhere($l2); } + + no Moose; + __PACKAGE__->meta->make_immutable; } -class CgOp::While extends CgOp { +{ + package CgOp::While; + use Moose; + extends 'CgOp'; + has once => (is => 'ro', isa => 'Bool'); has until => (is => 'ro', isa => 'Bool'); - method var_cg ($cg) { + sub var_cg { + my ($self, $cg) = @_; my ($check, $body) = @{ $self->zyg }; my $lagain = $cg->label; my $lcheck = $self->once ? 0 : $cg->label; @@ -66,13 +103,21 @@ class CgOp::While extends CgOp { $cg->cgoto($lagain); } } + + no Moose; + __PACKAGE__->meta->make_immutable; } -class CgOp::Let extends CgOp { +{ + package CgOp::Let; + use Moose; + extends 'CgOp'; + has var => (is => 'ro', isa => 'Str', required => 1); has type => (is => 'ro', isa => 'Str', required => 1); - method var_cg ($cg) { + sub var_cg { + my ($self, $cg) = @_; $cg->lextypes($self->var, $self->type); $self->zyg->[0]->var_cg($cg); @@ -81,6 +126,9 @@ class CgOp::Let extends CgOp { $cg->push_null($self->type); $cg->rawlexput($self->var, 0); } + + no Moose; + __PACKAGE__->meta->make_immutable; } # just a bunch of smart constructors diff --git a/Decl.pm b/Decl.pm index 941de02c..8516fc3a 100644 --- a/Decl.pm +++ b/Decl.pm @@ -1,80 +1,113 @@ +use strict; +use warnings; use 5.010; -use MooseX::Declare; use CgOp; -class Decl { +{ + package Decl; + use Moose; + has zyg => (is => 'ro', isa => 'ArrayRef', default => sub { [] }); - sub used_slots () { } + sub used_slots { } sub preinit_code { CgOp::noop } sub enter_code { CgOp::noop } sub write {} + + __PACKAGE__->meta->make_immutable; + no Moose; } -class Decl::PreInit extends Decl { +{ + package Decl::PreInit; + use Moose; + extends 'Decl'; + has var => (isa => 'Str', is => 'ro', predicate => 'has_var'); has code => (isa => 'Body', is => 'ro', required => 1); has shared => (isa => 'Bool', is => 'ro', default => 0); - method used_slots () { + sub used_slots { + my ($self) = @_; return $self->has_var ? ($self->var) : (); } - method preinit_code ($body) { + sub preinit_code { + my ($self, $body) = @_; $self->code->outer($body); my $c = CgOp::subcall(CgOp::protosub($self->code)); $self->has_var ? CgOp::proto_var($self->var, $c) : CgOp::sink($c); } - method enter_code ($body) { + sub enter_code { + my ($self, $body) = @_; !$self->has_var ? CgOp::noop : ($self->shared || $body->mainline) ? CgOp::share_lex($self->var) : CgOp::copy_lex($self->var); } - method write ($body) { + sub write { + my ($self, $body) = @_; $self->code->outer($body); $self->code->write; } + + __PACKAGE__->meta->make_immutable; + no Moose; } -class Decl::Sub extends Decl { +{ + package Decl::Sub; + use Moose; + extends 'Decl'; + has var => (isa => 'Str', is => 'ro', required => 1); has code => (isa => 'Body', is => 'ro', required => 1); - method used_slots () { - return $self->var; + sub used_slots { + return $_[0]->var; } - method preinit_code ($body) { + sub preinit_code { + my ($self, $body) = @_; $self->code->outer($body); CgOp::proto_var($self->var, CgOp::newscalar( CgOp::protosub($self->code))); } - method enter_code ($body) { + sub enter_code { + my ($self, $body) = @_; $body->mainline ? CgOp::share_lex($self->var) : CgOp::clone_lex($self->var); } - method write ($body) { + sub write { + my ($self, $body) = @_; $self->code->outer($body); $self->code->write; } + + __PACKAGE__->meta->make_immutable; + no Moose; } -class Decl::SimpleVar extends Decl { +{ + package Decl::SimpleVar; + use Moose; + extends 'Decl'; + has slot => (isa => 'Str', is => 'ro', required => 1); has list => (isa => 'Bool', is => 'ro', default => 0); - method used_slots { - return $self->slot; + sub used_slots { + return $_[0]->slot; } - method preinit_code ($body) { + sub preinit_code { + my ($self, $body) = @_; if ($self->list) { CgOp::proto_var($self->slot, @@ -85,38 +118,57 @@ class Decl::SimpleVar extends Decl { } } - method enter_code ($body) { + sub enter_code { + my ($self, $body) = @_; $body->mainline ? CgOp::share_lex($self->slot) : CgOp::copy_lex($self->slot); } - method write ($body) { + sub write { + my ($self, $body) = @_; } + + __PACKAGE__->meta->make_immutable; + no Moose; } -class Decl::StateVar extends Decl { +{ + package Decl::StateVar; + use Moose; + extends 'Decl'; + has slot => (isa => 'Str', is => 'ro', required => 1); has backing => (isa => 'Str', is => 'ro', required => 1); - method used_slots { - return $self->slot; + sub used_slots { + return $_[0]->slot; } - method preinit_code ($body) { + sub preinit_code { + my ($self, $body) = @_; CgOp::proto_var($self->slot, CgOp::scopedlex($self->backing)); } - method enter_code ($body) { + sub enter_code { + my ($self, $body) = @_; CgOp::scopedlex($self->slot, CgOp::scopedlex($self->backing)); } + + __PACKAGE__->meta->make_immutable; + no Moose; } -class Decl::RunMainline extends Decl { - method used_slots { '!mainline' } +{ + package Decl::RunMainline; + use Moose; + extends 'Decl'; + + sub used_slots { '!mainline' } - method preinit_code ($body) { + sub preinit_code { + my ($self, $body) = @_; # XXX ought not to have side effects here. $::SETTING_RESUME = $body; @@ -129,14 +181,21 @@ class Decl::RunMainline extends Decl { CgOp::newscalar(CgOp::aux('protopad')))); } - method enter_code ($body) { + sub enter_code { + my ($self, $body) = @_; $body->mainline ? CgOp::share_lex('!mainline') : CgOp::clone_lex('!mainline'); } + + __PACKAGE__->meta->make_immutable; + no Moose; } -class Decl::Class extends Decl { +{ + package Decl::Class; + use Moose; + has name => (is => 'ro', isa => 'Str', predicate => 'has_name'); has var => (is => 'ro', isa => 'Str', required => 1); has bodyvar => (is => 'ro', isa => 'Str'); @@ -144,7 +203,8 @@ class Decl::Class extends Decl { has parents => (is => 'ro', isa => 'ArrayRef', default => sub { [] }); has body => (is => 'ro', isa => 'Body'); - method used_slots () { + sub used_slots { + my ($self) = @_; if ($self->stub) { ($self->var, $self->var . '!HOW'); } else { @@ -152,7 +212,9 @@ class Decl::Class extends Decl { } } - method preinit_code ($body) { + sub preinit_code { + my ($self, $body) = @_; + if ($self->stub) { return CgOp::prog( CgOp::proto_var($self->var . '!HOW', CgOp::null('Variable')), @@ -179,7 +241,8 @@ class Decl::Class extends Decl { CgOp::methodcall(CgOp::aux("how"), "create-protoobject"))); } - method enter_code ($body) { + sub enter_code { + my ($self, $body) = @_; CgOp::prog( CgOp::share_lex($self->var . '!HOW'), CgOp::share_lex($self->var), @@ -189,18 +252,27 @@ class Decl::Class extends Decl { CgOp::clone_lex($self->bodyvar)))); } - method write ($body) { + sub write { + my ($self, $body) = @_; return unless $self->body; $self->body->outer($body); $self->body->write; } + + __PACKAGE__->meta->make_immutable; + no Moose; } -class Decl::HasMethod extends Decl { +{ + package Decl::HasMethod; + use Moose; + extends 'Decl'; + has name => (is => 'ro', isa => 'Str', required => 1); has var => (is => 'ro', isa => 'Str', required => 1); - method preinit_code ($body) { + sub preinit_code { + my ($self, $body) = @_; if ($body->type ne 'class') { #TODO: Make this a sorry. die "Tried to set a method outside a class!"; @@ -210,12 +282,20 @@ class Decl::HasMethod extends Decl { CgOp::wrap(CgOp::clr_string($self->name)), CgOp::scopedlex($self->var))); } + + __PACKAGE__->meta->make_immutable; + no Moose; } -class Decl::Super extends Decl { +{ + package Decl::Super; + use Moose; + extends 'Decl'; + has name => (is => 'ro', isa => 'Str', required => 1); - method preinit_code ($body) { + sub preinit_code { + my ($self, $body) = @_; if ($body->type ne 'class') { #TODO: Make this a sorry. die "Tried to set a superclass outside an initial class!"; @@ -225,13 +305,24 @@ class Decl::Super extends Decl { CgOp::methodcall(CgOp::aux('how'), "add-super", CgOp::scopedlex($self->name . "!HOW"))); } + + __PACKAGE__->meta->make_immutable; + no Moose; } -class Decl::Regex extends Decl { +{ + package Decl::Regex; + use Moose; + extends 'Decl'; + has slot => (is => 'ro', isa => 'Str', required => 1); - method preinit_code ($body) { + sub preinit_code { + my ($self, $body) = @_; } + + __PACKAGE__->meta->make_immutable; + no Moose; } 1;