[mm] Fix static $*foo cases, compiler driver

sorear · Sep 28, 2010 · d75ad08 · d75ad08
1 parent 6878346
commit d75ad08
Show file tree

Hide file tree

Showing 6 changed files with 55 additions and 54 deletions.
diff --git a/Niecza.proj b/Niecza.proj
@@ -16,7 +16,7 @@
     </PropertyGroup>
 
     <ItemGroup>
-        <CompilerPerl Include="src\Body.pm;src\CClass.pm;src\CgOp.pm;src\CodeGen.pm;src\CompilerDriver.pm;src\Decl.pm;src\Op.pm;src\Optimizer\Beta.pm;src\Optimizer\RxSimple.pm;src\ResolveLex.pm;src\RxOp.pm;src\Sig.pm;src\Unit.pm;src\Niecza\Actions.pm;src\Niecza\Grammar.pmc"/>
+        <CompilerPerl Include="src\Body.pm;src\CClass.pm;src\CgOp.pm;src\CSharpBackend.pm;src\CodeGen.pm;src\CompilerDriver.pm;src\Metamodel.pm;src\Op.pm;src\Optimizer\Beta.pm;src\Optimizer\RxSimple.pm;src\RxOp.pm;src\Sig.pm;src\Unit.pm;src\Niecza\Actions.pm;src\Niecza\Grammar.pmc"/>
     </ItemGroup>
 
     <!-- Meta targets -->

diff --git a/src/CSharpBackend.pm b/src/CSharpBackend.pm
@@ -209,12 +209,11 @@ sub pkg3 {
 sub enter_code {
     my ($body) = @_;
     my @code;
-    # in this case, the variables were initialized earlier and are still useful
-    goto novars if $body->run_once && $body->spad_exists;
-
     for my $ln (sort keys %{ $body->lexicals }) {
         my $lx = $body->lexicals->{$ln};
 
+        next if $body->run_once && $body->spad_exists && !dynname($ln);
+
         if ($lx->isa('Metamodel::Lexical::SubDef')) {
             push @code, access_lex($body, $ln,
                 CgOp::newscalar(CgOp::rawscall('Kernel.MakeSub',
@@ -271,7 +270,7 @@ sub access_lex {
 
     if ($lex->isa('Metamodel::Lexical::SubDef') ||
             $lex->isa('Metamodel::Lexical::Simple')) {
-        if ($bp->run_once) {
+        if ($bp->run_once && !dynname($name)) {
             return $set_to ? CgOp::rawsset($lex->{peer}, $set_to) :
                 CgOp::rawsget($lex->{peer});
         } elsif ((my $ix = $lex->{peer}) >= 0) {
@@ -346,6 +345,7 @@ sub codegen_sub {
         usednamed => $_->{peer}{uname}, minlets => $_->{peer}{nlexn});
 }
 
+sub dynname { $_[0] =~ /^.?[*?]/ }
 # lumped under a sub are all the static-y lexicals
 # protopads and proto-sub-instances need to exist early because methods, in
 # particular, bind to them
@@ -371,11 +371,11 @@ sub sub0 {
 
         if ($lx->isa('Metamodel::Lexical::SubDef') ||
                 $lx->isa('Metamodel::Lexical::Simple')) {
-            if ($_->run_once) {
-                push @decls, ($lx->{peer} = gsym('Variable', $ln));
-            } elsif ($ln =~ /^.?[*?]/) {
+            if (dynname($ln)) {
                 $lx->{peer} = -1;
                 $uname = 1;
+            } elsif ($_->run_once) {
+                push @decls, ($lx->{peer} = gsym('Variable', $ln));
             } else {
                 $lx->{peer} = ($nlexn++);
             }
@@ -437,7 +437,7 @@ sub sub2 {
 sub protolset {
     my ($body, $lname, $lex, $frag) = @_;
 
-    if ($body->run_once) {
+    if ($body->run_once && !dynname($lname)) {
         push @thaw, CgOp::rawsset($lex->{peer}, $frag);
     } elsif ((my $ix = $lex->{peer}) >= 4) {
         push @thaw, CgOp::setindex(CgOp::int($ix - 4),

diff --git a/src/CompilerDriver.pm b/src/CompilerDriver.pm
@@ -254,6 +254,7 @@ sub compile {
             }
             print STDERR "@args\n" if $args{stagetime};
             system @args;
+            $ast = undef;
         } ],
         [ 'aot', sub {
             system "mono", "--aot", $outfile;
@@ -267,7 +268,7 @@ sub compile {
         printf "%-20s: %gs\n", "$basename " . $p->[0],
             $t2 - $t1 if $args{stagetime};
         if ($args{stopafter} && $args{stopafter} eq $p->[0]) {
-            if ($ast) {
+            if ($ast && $args{stopafter} ne 'writecs') {
                 print STDERR YAML::XS::Dump($ast);
             }
             return;

diff --git a/src/Metamodel.pm b/src/Metamodel.pm
@@ -802,7 +802,7 @@ sub Op::Super::begin {
 
 sub Op::SubDef::begin {
     my $self = shift;
-    my $body = $self->body->begin;
+    my $body = $self->body->begin(once => $self->once);
     $opensubs[-1]->add_my_sub($self->var, $body);
     my $r;
     if (@{ $self->exports } || defined($self->method_too) ||

diff --git a/test.pl b/test.pl
@@ -2,7 +2,7 @@
 
 use Test;
 
-plan 534;
+plan 520;
 
 ok 1, "one is true";
 ok 2, "two is also true";
@@ -374,24 +374,6 @@
     ok (1,*).^isa(Parcel), "infix:<,> doesn't curry";
 }
 
-{
-    class Foo {
-        method foo() { 42 }
-        class Bar {
-            method bar() { 51 }
-        }
-        ok Bar.bar == 51, "within Foo, Bar is directly accessible";
-        ok OUR::Bar.bar == 51, "within Foo, Bar is package accessible";
-        ok Foo::Bar.bar == 51, "within Foo, Bar is longname accessible";
-        ok GLOBAL::Foo::Bar.bar == 51, "within Foo, Bar is GLOBAL accessible";
-    }
-    ok Foo eq 'Foo()', "lexical lookup of our-class works";
-    ok OUR::Foo eq 'Foo()', "also visible in ourpad";
-    ok GLOBAL::Foo eq 'Foo()', "also visible globally";
-    ok Foo::Bar.bar == 51, "can call through nested methods";
-    ok GLOBAL::Foo::Bar.bar == 51, "can call through GLOBAL nested";
-}
-
 {
     my $x1; my $x2; my $x3; my $x4;
     $x1 = 1 if 0;
@@ -614,30 +596,6 @@
     ok !G3.parse("y"), "capturing subrules work (negative)";
 }
 
-{
-    {
-        our $x = 5; #OK
-    }
-    ok $::x == 5, '$::x finds our variable';
-
-    package Fao { our $y = 6; } #OK
-    ok $::Fao::y == 6, '$::Fao::y works as $Fao::y';
-
-    { class Mao { } }
-    ok ::Mao.new.defined, 'can use classes via ::Mao';
-}
-
-{
-    my $x = 7; #OK
-    ok $::x == 7, '$::x can find lexicals';
-    class A3 {
-        method moo { 42 }
-        class B4 {
-            ok ::A3.moo, '::A3 can find outer classes';
-        }
-    }
-}
-
 {
     ok (&infix:<+>)(2,2) == 4, '&infix:<+> syntax works';
 }

diff --git a/test2.pl b/test2.pl
@@ -21,5 +21,47 @@
 is $?FILE, 'test.pl', '$?FILE works';
 is $?ORIG.substr(0,5), '# vim', '$?ORIG works';
 
+{
+    {
+        our $x = 5; #OK
+    }
+    ok $::x == 5, '$::x finds our variable';
+
+    package Fao { our $y = 6; } #OK
+    ok $::Fao::y == 6, '$::Fao::y works as $Fao::y';
+
+    { class Mao { } }
+    ok ::Mao.new.defined, 'can use classes via ::Mao';
+}
+
+{
+    my $x = 7; #OK
+    ok $::x == 7, '$::x can find lexicals';
+    class A3 {
+        method moo { 42 }
+        class B4 {
+            ok ::A3.moo, '::A3 can find outer classes';
+        }
+    }
+}
+
+{
+    class Foo {
+        method foo() { 42 }
+        class Bar {
+            method bar() { 51 }
+        }
+        ok Bar.bar == 51, "within Foo, Bar is directly accessible";
+        ok OUR::Bar.bar == 51, "within Foo, Bar is package accessible";
+        ok Foo::Bar.bar == 51, "within Foo, Bar is longname accessible";
+        ok GLOBAL::Foo::Bar.bar == 51, "within Foo, Bar is GLOBAL accessible";
+    }
+    ok Foo eq 'Foo()', "lexical lookup of our-class works";
+    ok OUR::Foo eq 'Foo()', "also visible in ourpad";
+    ok GLOBAL::Foo eq 'Foo()', "also visible globally";
+    ok Foo::Bar.bar == 51, "can call through nested methods";
+    ok GLOBAL::Foo::Bar.bar == 51, "can call through GLOBAL nested";
+}
+
 
 done-testing;