Implement temp $*foo

sorear · Oct 21, 2010 · 4b358b4 · 4b358b4
1 parent 94651cd
commit 4b358b4
Show file tree

Hide file tree

Showing 5 changed files with 37 additions and 12 deletions.
diff --git a/lib/Kernel.cs b/lib/Kernel.cs
@@ -902,17 +902,15 @@ public class Kernel {
             return new VarDeque(tmp);
         }
 
-        public static Variable ContextHelper(Frame th, string name) {
+        public static Variable ContextHelper(Frame th, string name, int up) {
             object rt;
             while (th != null) {
-                if (th.lex == null) {
-                    th = th.caller;
-                    continue;
-                }
-                if (th.lex.TryGetValue(name, out rt)) {
+                if (up <= 0 && th.lex != null &&
+                        th.lex.TryGetValue(name, out rt)) {
                     return (Variable)rt;
                 }
                 th = th.caller;
+                up--;
             }
             name = name.Remove(1,1);
             Dictionary<string,BValue> gstash = (Dictionary<string,BValue>)

diff --git a/src/CgOp.pm b/src/CgOp.pm
@@ -222,7 +222,7 @@ use warnings;
     sub take           { rawscall('Kernel.Take', $_[0]) }
     sub control        { rawscall('Kernel.SearchForHandler', CgOp::int(shift()),
             @_) }
-    sub context_get    { rawscall('Kernel.ContextHelper', callframe(), $_[0]) }
+    sub context_get    { rawscall('Kernel.ContextHelper', callframe(), $_[0], $_[1]) }
     sub startgather    { rawscall('Kernel.GatherHelper', $_[0]) }
     sub get_first      { rawscall('Kernel.GetFirst', $_[0]) }
     sub instrole       { rawscall('Kernel.InstantiateRole', $_[0]) }

diff --git a/src/Niecza/Actions.pm b/src/Niecza/Actions.pm
@@ -1306,7 +1306,25 @@ sub POSTFIX { my ($cl, $M) = @_;
 
 sub PREFIX { my ($cl, $M) = @_;
     my $op = '&prefix:<' . $M->{sym} . '>';
-    my ($st, $arg) = $cl->whatever_precheck($op, $M->{arg}{_ast});
+    my $rarg = $M->{arg}{_ast};
+
+    # Macros
+    if ($op eq '&prefix:<temp>') {
+        if (!$rarg->isa('Op::ContextVar') || $rarg->uplevel) {
+            $M->sorry('Non-contextual case of temp NYI');
+            $M->{_ast} = Op::StatementList->new;
+            return;
+        }
+        $M->{_ast} = Op::CallSub->new(
+            invocant => Op::Lexical->new(name => '&infix:<=>'),
+            args => [ Op::Lexical->new(name => $rarg->name, declaring => 1,
+                        hash => scalar($rarg->name =~ /^%/),
+                        list => scalar($rarg->name =~ /^@/)),
+                      Op::ContextVar->new(name => $rarg->name, uplevel => 1) ]);
+        return;
+    }
+
+    my ($st, $arg) = $cl->whatever_precheck($op, $rarg);
     $M->{_ast} = $cl->whatever_postcheck($M, $st, Op::CallSub->new(node($M),
         invocant => Op::Lexical->new(name => $op),
         positionals => [ $M->{arg}{_ast} ]));

diff --git a/src/Op.pm b/src/Op.pm
@@ -179,7 +179,7 @@ use CgOp;
         my ($self, $body) = @_;
         # this should be a little fancier so closure can work
         CgOp::subcall(CgOp::fetch(CgOp::context_get(CgOp::clr_string(
-                        '*resume_' . $self->unitname))));
+                        '*resume_' . $self->unitname), CgOp::int(0))));
     }
 
     __PACKAGE__->meta->make_immutable;
@@ -893,10 +893,11 @@ use CgOp;
     extends 'Op';
 
     has name => (isa => 'Str', is => 'ro', required => 1);
+    has uplevel => (isa => 'Int', is => 'ro', default => 0);
 
     sub code {
         my ($self, $body) = @_;
-        CgOp::context_get(CgOp::clr_string($self->name));
+        CgOp::context_get(CgOp::clr_string($self->name), CgOp::int($self->uplevel));
     }
 
     __PACKAGE__->meta->make_immutable;
@@ -1012,7 +1013,6 @@ use CgOp;
     has name => (isa => 'Str', is => 'ro', default => '');
     has passcap => (isa => 'Bool', is => 'ro', default => 0);
     has passcut => (isa => 'Bool', is => 'ro', default => 0);
-    has sym => (isa => 'Maybe[Str]', is => 'ro');
     has pre => (isa => 'ArrayRef[Op]', is => 'ro', default => sub { [] });
     has canback => (isa => 'Bool', is => 'ro', default => 1);
 
@@ -1021,7 +1021,6 @@ use CgOp;
     sub code {
         my ($self, $body) = @_;
 
-        local $::symtext = $self->sym;
         my @mcaps;
         local $::in_quant = 0;
         if (!$self->passcap) {

diff --git a/test2.pl b/test2.pl
@@ -67,6 +67,16 @@
 
     ok !(try die "foo").defined, "try of an error is undef";
     is $!, "foo", 'the error goes into $!';
+
+    {
+        my @*foo = 1, 2, 3;
+        {
+            temp @*foo;
+            push @*foo, 4;
+            is +@*foo, 4, '@*foo has 4 elements in temp scope';
+        }
+        is +@*foo, 3, '@*foo has 3 elements again after temp';
+    }
 }
 
 # {