Implement the 'state' declarator

sorear · Jul 17, 2010 · bd10167 · bd10167
1 parent 8f73f31
commit bd10167
Show file tree

Hide file tree

Showing 3 changed files with 57 additions and 6 deletions.
diff --git a/Decl.pm b/Decl.pm
@@ -122,6 +122,32 @@ use CgOp;
     no Moose;
 }
 
+{
+    package Decl::StateVar;
+    use Moose;
+    extends 'Decl';
+
+    has slot    => (isa => 'Str', is => 'ro', required => 1);
+    has backing => (isa => 'Str', is => 'ro', required => 1);
+
+    sub used_slots {
+        return $_[0]->slot;
+    }
+
+    sub preinit_code {
+        my ($self, $body) = @_;
+        CgOp::proto_var($self->slot, CgOp::scopedlex($self->backing));
+    }
+
+    sub enter_code {
+        my ($self, $body) = @_;
+        CgOp::scopedlex($self->slot, CgOp::scopedlex($self->backing));
+    }
+
+    __PACKAGE__->meta->make_immutable;
+    no Moose;
+}
+
 {
     package Decl::RunMainline;
     use Moose;

diff --git a/Niecza/Actions.pm b/Niecza/Actions.pm
@@ -655,7 +655,8 @@ sub variable_declarator { my ($cl, $M) = @_;
         return;
     }
 
-    my $slot = $M->{variable}{_ast}{decl_slot};
+    my $name = $M->{variable}{_ast}{decl_slot};
+    my $slot = $name;
 
     if (!$slot) {
         $M->sorry("Cannot apply a declarator to a non-simple variable");
@@ -669,7 +670,7 @@ sub variable_declarator { my ($cl, $M) = @_;
         return;
     }
 
-    if ($scope eq 'has' || $scope eq 'our' || $scope eq 'state') {
+    if ($scope eq 'has' || $scope eq 'our') {
         $M->sorry("Unsupported scope $scope for simple variable");
         return;
     }
@@ -678,10 +679,18 @@ sub variable_declarator { my ($cl, $M) = @_;
         $slot = $cl->gensym;
     }
 
-    push @{ $::CURLEX->{'!decls'} //= [] },
-        Decl::SimpleVar->new(slot => $slot);
+    if ($scope eq 'state') {
+        my $ts = $cl->statevar;
+        push @{ $::CURLEX->{'!decls'} //= [] },
+            Decl::StateVar->new(backing => $ts, slot => $slot);
+
+        $M->{_ast} = Op::Lexical->new(name => $slot, state_decl => 1);
+    } else {
+        push @{ $::CURLEX->{'!decls'} //= [] },
+            Decl::SimpleVar->new(slot => $slot);
 
-    $M->{_ast} = Op::Lexical->new(name => $slot);
+        $M->{_ast} = Op::Lexical->new(name => $slot);
+    }
 }
 
 sub package_declarator {}

diff --git a/test.pl b/test.pl
@@ -10,7 +10,7 @@ ($num)
     say ("1.." ~ $num);
 }
 
-plan 59;
+plan 62;
 
 ok 1, "one is true";
 ok 2, "two is also true";
@@ -210,3 +210,19 @@ ($num)
     ok $z() == 42, "old sub keeps old value";
 }
 
+{
+    sub accum() {
+        anon sub go() {
+            state $x;
+            START { $x = 0; }
+            $x++;
+        }
+    }
+
+    my $f = accum;
+    my $g = accum;
+
+    ok $f() == 0, "state variables can be initialized";
+    ok $f() == 1, "state variables preserve values";
+    ok $g() == 0, "different clones have different state vars";
+}