diff --git a/CodeGen.pm b/CodeGen.pm index ffaddadb..473f2e80 100644 --- a/CodeGen.pm +++ b/CodeGen.pm @@ -117,7 +117,7 @@ use 5.010; } } - sub _swap { + sub swap { my ($self) = @_; $self->_undercheck(2); $self->_overcheck(1); @@ -332,11 +332,22 @@ use 5.010; $self->_cpscall(undef, "$c.lv.container.Store(th, $v)"); } + sub dup { + my ($self) = @_; + my $c = $self->_peek; + $self->_push($self->stacktype->[-1], $c); + } + + sub drop { + my ($self) = @_; + $self->_pop; + } + sub dup_fetch { my ($self) = @_; my $c = $self->_peek; $self->_cpscall('IP6', "$c.lv.container.Fetch(th)"); - $self->_swap; + $self->swap; } sub pos { @@ -496,9 +507,9 @@ use 5.010; sub attr_set { my ($self, $f) = @_; - $self->_swap; + $self->swap; $self->attr_var($f); - $self->_swap; + $self->swap; $self->store; } diff --git a/Niecza/Actions.pm b/Niecza/Actions.pm index bba0816b..cab8f5d1 100644 --- a/Niecza/Actions.pm +++ b/Niecza/Actions.pm @@ -195,6 +195,12 @@ sub infixish { my ($cl, $M) = @_; $M->sorry("Adverbs NYI") if $M->{colonpair}; } sub INFIX { my ($cl, $M) = @_; + if ($M->{infix}{sym} eq ':=') { #XXX macro + $M->{_ast} = Op::Bind->new( + lhs => $M->{left}{_ast}, rhs => $M->{right}{_ast}, + readonly => 0); + return; + } $M->{_ast} = Op::CallSub->new( invocant => Op::Lexical->new(name => '&infix:<' . $M->{infix}{sym} . '>'), positionals => [ $M->{left}{_ast}, $M->{right}{_ast} ]); diff --git a/Op.pm b/Op.pm index 4105e01f..78c9bd33 100644 --- a/Op.pm +++ b/Op.pm @@ -265,6 +265,36 @@ use 5.010; no Moose; } +{ + package Op::Bind; + use Moose; + 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 item_cg { + my ($self, $cg, $body) = @_; + $self->lhs->item_cg($cg, $body); + $cg->dup; + $self->rhs->item_cg($cg, $body); + $cg->clr_field_get('lv'); + $cg->clr_field_set('lv'); + } + + sub void_cg { + my ($self, $cg, $body) = @_; + $self->lhs->item_cg($cg, $body); + $self->rhs->item_cg($cg, $body); + $cg->clr_field_get('lv'); + $cg->clr_field_set('lv'); + } + + __PACKAGE__->meta->make_immutable; + no Moose; +} + { package Op::Lexical; use Moose;