Unify handling of setting and programs in CompilerDriver

sorear · Jul 23, 2010 · 92aafc8 · 92aafc8
1 parent a7a25a2
commit 92aafc8
Show file tree

Hide file tree

Showing 4 changed files with 33 additions and 34 deletions.
diff --git a/CompilerDriver.pm b/CompilerDriver.pm
@@ -4,7 +4,7 @@ use warnings;
 use 5.010;
 
 use Sub::Exporter -setup => {
-    exports => [ qw(header setting mainline ast) ]
+    exports => [ qw(compile) ]
 };
 
 open ::NIECZA_OUT, ">&", \*STDOUT;
@@ -23,43 +23,43 @@ use Storable;
 use Niecza::Grammar ();
 use Niecza::Actions ();
 
-sub header {
     print ::NIECZA_OUT <<EOH;
 using System;
 using System.Collections.Generic;
 using Niecza;
 
 EOH
-}
 
-sub setting {
+sub compile {
+    my %args = @_;
+    $args{lang} //= 'CORE';
+
     local $::SETTING_RESUME;
     local $::YOU_WERE_HERE;
-    local $::UNITNAME = 'CORE';
+    local $::UNITNAME = $args{main} ? '' : $args{file};
+    $::UNITNAME =~ s/\.(?:pm6?|setting)//;
+    $::UNITNAME =~ s|[\\/]|.|g;
     $STD::ALL = {};
-    my $setting_ast = Niecza::Grammar->parsefile("CORE.setting",
-        setting => 'NULL', actions => 'Niecza::Actions')->{_ast};
 
-    $setting_ast->write;
-    store $::SETTING_RESUME, 'CORE_ast.store';
-}
+    $::SETTING_RESUME = retrieve($args{lang} . '_ast.store')
+        unless $args{lang} eq 'NULL';
 
-sub mainline {
-    my $code = shift;
-    local $::UNITNAME = '';
-    local $::SETTING_RESUME = retrieve 'CORE_ast.store';
-    $STD::ALL = {};
-    Niecza::Grammar->parse($code, actions => 'Niecza::Actions')->{_ast}->write;
-}
+    my ($m, $a) = $args{file} ? ('parsefile', $args{file}) :
+        ('parse', $args{code});
+    my $ast = Niecza::Grammar->$m($a, setting => $args{lang},
+        actions => 'Niecza::Actions')->{_ast};
 
-sub ast {
-    my $code = shift;
-    local $::UNITNAME = 'Mainline';
-    $STD::ALL = {};
-    my $a = Niecza::Grammar->parse($code, actions => 'Niecza::Actions')->{_ast};
-    delete $a->mainline->{outer};
-    delete $a->{setting};
-    print YAML::XS::Dump($a);
+    if ($args{ast}) {
+        delete $a->mainline->{outer};
+        delete $a->{setting};
+        print STDOUT YAML::XS::Dump($a);
+        return;
+    }
+
+    $::SETTING_RESUME = undef;
+    $ast->write;
+    store $::SETTING_RESUME, ($::UNITNAME . '_ast.store')
+        if $::SETTING_RESUME;
 }
 
 1;
diff --git a/Makefile b/Makefile
@@ -8,14 +8,14 @@ all: CORE.dll
 	git rev-parse HEAD | cut -c1-7 > VERSION
 
 test: $(COMPILER) test.pl CORE.dll
-	perl -MFile::Slurp -MCompilerDriver=:all -e 'header; mainline(scalar read_file("test.pl"))' > Program.cs
+	perl -MFile::Slurp -MCompilerDriver=:all -e 'compile(main => 1, file => "test.pl")' > Program.cs
 	gmcs /r:Kernel.dll /r:CORE.dll Program.cs
 	prove -e 'mono --debug=casts' Program.exe
 
 .DELETE_ON_ERROR:
 
 CORE.cs: $(COMPILER) CORE.setting
-	perl -MCompilerDriver=:all -e 'header; setting' > CORE.cs
+	perl -MCompilerDriver=:all -e 'compile(lang => "NULL", file => "CORE.setting")' > CORE.cs
 
 Kernel.dll: Kernel.cs
 	gmcs /target:library /out:Kernel.dll Kernel.cs

diff --git a/Unit.pm b/Unit.pm
@@ -22,24 +22,24 @@ use 5.010;
     sub gen_code {
         my ($self) = @_;
         $self->mainline->outer($self->setting) if $self->setting;
-        CodeGen->know_module($self->setting_name);
+        CodeGen->know_module($self->csname($self->setting_name));
         CodeGen->know_module($self->csname);
         CodeGen->new(name => 'BOOT', entry => 1,
             ops => CgOp::letn('pkg', CgOp::rawsget('Kernel.Global'),
-                CgOp::rawscall($self->setting_name . '.Initialize'),
+                CgOp::rawscall($self->csname($self->setting_name) . '.Initialize'),
                 CgOp::letn('protopad',
-                    CgOp::cast('Frame', CgOp::rawsget($self->setting_name .
+                    CgOp::cast('Frame', CgOp::rawsget($self->csname($self->setting_name) .
                             '.Environment')),
                     ($self->is_setting ?
                         CgOp::rawsset($self->csname . '.Installer',
                             CgOp::protosub($self->mainline)) :
-                        CgOp::subcall(CgOp::rawsget($self->setting_name . '.Installer'),
+                        CgOp::subcall(CgOp::rawsget($self->csname($self->setting_name) . '.Installer'),
                             CgOp::newscalar(CgOp::protosub($self->mainline)))),
                     CgOp::return())));
     }
 
     sub csname {
-        my $x = $_[0]->name;
+        my $x = $_[1] // $_[0]->name;
         $x =~ s/::/./g;
         $x ||= 'MAIN';
         $x;

diff --git a/niecza_eval b/niecza_eval
@@ -36,8 +36,7 @@ sub run {
         return;
     }
     open ::NIECZA_OUT, ">", "Program.cs";
-    header;
-    mainline(shift);
+    compile(main => 1, code => shift(), ast => $ast);
     close ::NIECZA_OUT;
 
     system 'gmcs /r:Kernel.dll /r:CORE.dll Program.cs';