From b861595f584cb071fd7ab35e2dd0df482c49028a Mon Sep 17 00:00:00 2001 From: Stefan O'Rear Date: Tue, 20 Jul 2010 22:25:43 -0700 Subject: [PATCH] Unify aux and let --- CgOp.pm | 40 +++++++--------------------------------- CodeGen.pm | 40 ++++++++++++++++++++-------------------- Decl.pm | 12 ++++++------ Unit.pm | 2 +- 4 files changed, 34 insertions(+), 60 deletions(-) diff --git a/CgOp.pm b/CgOp.pm index daefec51..3dd8e8aa 100644 --- a/CgOp.pm +++ b/CgOp.pm @@ -108,29 +108,6 @@ use warnings; __PACKAGE__->meta->make_immutable; } -{ - package CgOp::Let; - use Moose; - extends 'CgOp'; - - has var => (is => 'ro', isa => 'Str', required => 1); - has type => (is => 'ro', isa => 'Str', required => 1); - - sub var_cg { - my ($self, $cg) = @_; - - $cg->lextypes($self->var, $self->type); - $self->zyg->[0]->var_cg($cg); - $cg->rawlexput($self->var, 0); - $self->zyg->[1]->var_cg($cg); - $cg->push_null($self->type); - $cg->rawlexput($self->var, 0); - } - - no Moose; - __PACKAGE__->meta->make_immutable; -} - # just a bunch of smart constructors { package CgOp; @@ -281,8 +258,8 @@ use warnings; CgOp::Primitive->new(op => [ 'callframe' ]); } - sub aux { - CgOp::Primitive->new(op => [ 'peek_aux', $_[0] ]); + sub letvar { + CgOp::Primitive->new(op => [ 'peek_let', $_[0] ]); } sub clr_string { @@ -354,13 +331,13 @@ use warnings; CgOp::Primitive->new(op => [ 'close_sub', $body->code ])); } - sub with_aux { + sub letn { my ($name, $type, $value, @stuff) = @_; prog( - CgOp::Primitive->new(op => [ 'push_aux', $name, $type ], + CgOp::Primitive->new(op => [ 'push_let', $name, $type ], zyg => [ $value ]), @stuff, - sink(CgOp::Primitive->new(op => [ 'pop_aux', $name ]))); + sink(CgOp::Primitive->new(op => [ 'pop_let', $name ]))); } sub pos { @@ -381,11 +358,8 @@ use warnings; my $nextlet = 0; sub let { my ($head, $type, $bodyf) = @_; - my $v = 'let!' . ($nextlet++); - my $body = $bodyf->(CgOp::Primitive->new( - op => [ rawlexget => $v, 0 ])); - - CgOp::Let->new(var => $v, type => $type, zyg => [ $head, $body ]); + my $v = ($nextlet++); + letn($v, $type, $head, $bodyf->(letvar($v))); } } diff --git a/CodeGen.pm b/CodeGen.pm index 7119706c..8df0a2cf 100644 --- a/CodeGen.pm +++ b/CodeGen.pm @@ -92,7 +92,7 @@ use 5.010; has buffer => (isa => 'ArrayRef', is => 'ro', default => sub { [] }); has unreach => (isa => 'Bool', is => 'rw', default => 0); - has auxdepths => (isa => 'HashRef', is => 'ro', default => sub { +{} }); + has letdepths => (isa => 'HashRef', is => 'ro', default => sub { +{} }); has body => (isa => 'Body', is => 'ro'); has bodies => (isa => 'ArrayRef', is => 'ro', default => sub { [] }); @@ -111,7 +111,7 @@ use 5.010; my %save; $save{depth} = $self->depth; $save{stacktype} = [ @{ $self->stacktype } ]; - $save{auxdepths} = { %{ $self->auxdepths } }; + $save{letdepths} = { %{ $self->letdepths } }; $self->savedstks->{$lbl} = \%save; } @@ -121,7 +121,7 @@ use 5.010; $self->depth($save->{depth}); $self->savedepth($save->{depth}); @{ $self->stacktype } = @{ $save->{stacktype} }; - %{ $self->auxdepths } = %{ $save->{auxdepths} }; + %{ $self->letdepths } = %{ $save->{letdepths} }; } sub _emit { @@ -207,22 +207,22 @@ use 5.010; @{ $self->stacktype }[-1,-2] = @{ $self->stacktype }[-2,-1]; } - sub push_aux { + sub push_let { my ($self, $which, $ty) = @_; - my $var = "aux!${which}!" . ($self->auxdepths->{$which}++); + my $var = "let!${which}!" . ($self->letdepths->{$which}++); $self->lex2type->{$var} = $ty; $self->rawlexput($var); } - sub pop_aux { + sub pop_let { my ($self, $which) = @_; - my $var = "aux!${which}!" . (--$self->auxdepths->{$which}); + my $var = "let!${which}!" . (--$self->letdepths->{$which}); $self->rawlexget($var); } - sub peek_aux { + sub peek_let { my ($self, $which) = @_; - my $var = "aux!${which}!" . ($self->auxdepths->{$which} - 1); + my $var = "let!${which}!" . ($self->letdepths->{$which} - 1); $self->rawlexget($var); } @@ -289,9 +289,9 @@ use 5.010; sub lexget { my ($self, $order, $name) = @_; my $frame = 'th.'; - if ($self->auxdepths->{'protopad'}) { + if ($self->letdepths->{'protopad'}) { $frame = '((Frame)th.lex[' . - qm('aux!protopad!' . ($self->auxdepths->{'protopad'} - 1)) . + qm('let!protopad!' . ($self->letdepths->{'protopad'} - 1)) . ']).'; } # XXX need a better type tracking system @@ -302,9 +302,9 @@ use 5.010; sub lexput { my ($self, $order, $name) = @_; my $frame = 'th.'; - if ($self->auxdepths->{'protopad'}) { + if ($self->letdepths->{'protopad'}) { $frame = '((Frame)th.lex[' . - qm('aux!protopad!' . ($self->auxdepths->{'protopad'} - 1)) . + qm('let!protopad!' . ($self->letdepths->{'protopad'} - 1)) . ']).'; } $self->_emit($frame . ("outer." x $order) . "lex[" . qm($name) . "] = " . $self->_pop); @@ -313,9 +313,9 @@ use 5.010; sub callframe { my ($self) = @_; my $frame = 'th'; - if ($self->auxdepths->{'protopad'}) { + if ($self->letdepths->{'protopad'}) { $frame = '((Frame)th.lex[' . - qm('aux!protopad!' . ($self->auxdepths->{'protopad'} - 1)) . + qm('let!protopad!' . ($self->letdepths->{'protopad'} - 1)) . '])'; } $self->_push("Frame", $frame); @@ -518,9 +518,9 @@ use 5.010; sub close_sub { my ($self, $bodycg) = @_; - $self->pop_aux('protopad'); + $self->pop_let('protopad'); pop @{ $self->bodies }; - $self->peek_aux('protopad'); + $self->peek_let('protopad'); my $op = $self->_pop; my $pp = $self->_pop; $self->_push('IP6', "Kernel.MakeSub(new DynBlockDelegate(" . @@ -529,7 +529,7 @@ use 5.010; sub proto_var { my ($self, $name) = @_; - $self->peek_aux('protopad'); + $self->peek_let('protopad'); my $pp = $self->_pop; my $pv = $self->_pop; $self->_emit("$pp.lex[" . qm($name) . "] = $pv"); @@ -559,9 +559,9 @@ use 5.010; sub open_protopad { my ($self, $body) = @_; - $self->peek_aux('protopad'); + $self->peek_let('protopad'); $self->clr_new('Frame', 1); - $self->push_aux('protopad', 'Frame'); + $self->push_let('protopad', 'Frame'); push @{ $self->bodies }, $body; } diff --git a/Decl.pm b/Decl.pm index b2c6c254..9a590b9d 100644 --- a/Decl.pm +++ b/Decl.pm @@ -178,7 +178,7 @@ use CgOp; CgOp::rawscall('Kernel.MakeSub', CgOp::rawsget('Kernel.MainlineContinuation'), CgOp::null('Frame'), CgOp::null('Frame')), - CgOp::newscalar(CgOp::aux('protopad')))); + CgOp::newscalar(CgOp::letvar('protopad')))); } sub enter_code { @@ -221,11 +221,11 @@ use CgOp; $self->body->outer($body); - CgOp::with_aux("how", "Variable", + CgOp::letn("how", "Variable", CgOp::methodcall(CgOp::scopedlex("ClassHOW"), "new", CgOp::wrap(CgOp::clr_string($self->name // 'ANON'))), - CgOp::proto_var($self->var . '!HOW', CgOp::aux("how")), + CgOp::proto_var($self->var . '!HOW', CgOp::letvar("how")), # TODO: Initialize the protoobject to a failure here so an awesome # error is produced if someone tries to use an incomplete class in @@ -236,7 +236,7 @@ use CgOp; CgOp::newscalar( CgOp::protosub($self->body))), CgOp::scopedlex($self->var, - CgOp::methodcall(CgOp::aux("how"), "create-protoobject"))); + CgOp::methodcall(CgOp::letvar("how"), "create-protoobject"))); } sub enter_code { @@ -276,7 +276,7 @@ use CgOp; die "Tried to set a method outside a class!"; } CgOp::sink( - CgOp::methodcall(CgOp::aux("how"), "add-method", + CgOp::methodcall(CgOp::letvar("how"), "add-method", CgOp::wrap(CgOp::clr_string($self->name)), CgOp::scopedlex($self->var))); } @@ -300,7 +300,7 @@ use CgOp; } CgOp::sink( - CgOp::methodcall(CgOp::aux('how'), "add-super", + CgOp::methodcall(CgOp::letvar('how'), "add-super", CgOp::scopedlex($self->name . "!HOW"))); } diff --git a/Unit.pm b/Unit.pm index a10434c1..fd329c47 100644 --- a/Unit.pm +++ b/Unit.pm @@ -20,7 +20,7 @@ use 5.010; my ($self) = @_; $self->mainline->outer($self->setting) if $self->setting; CodeGen->new(name => 'BOOT', entry => 1, - ops => CgOp::with_aux('protopad', 'Frame', + ops => CgOp::letn('protopad', 'Frame', CgOp::cast('Frame', CgOp::fetch(CgOp::pos(0))), CgOp::return( CgOp::newscalar(