First round of compilation stage refactoring.

This separates the backend-independent stages from the backend-specific
stages. The methods that relate to a backend's stages move into the
Backend class.

A new :from(...) parameter to .compile enables various places that did
their own stage visiting, because they had a non-source start point, to
just use .compile instead, which is a pleasant cleanup.

Additionally, stage names are now properly validated.

Author: jnthn

src/HLL/Compiler.pm

@@ -76,6 +76,36 @@ class HLL::Backend::Parrot {
             pir::interpinfo__Ii(pir::const::INTERPINFO_ACTIVE_PMCS),
             ]);
     }
+    
+    method stages() {
+        'post pir evalpmc'
+    }
+    
+    method post($source, *%adverbs) {
+        nqp::getcomp('QAST').post($source)
+    }
+
+    method pirbegin() {
+        ".include 'cclass.pasm'\n"
+        ~ ".include 'except_severity.pasm'\n"
+        ~ ".include 'except_types.pasm'\n"
+        ~ ".include 'iglobals.pasm'\n"
+        ~ ".include 'interpinfo.pasm'\n"
+        ~ ".include 'iterator.pasm'\n"
+        ~ ".include 'sysinfo.pasm'\n"
+        ~ ".include 'stat.pasm'\n"
+        ~ ".include 'datatypes.pasm'\n"
+        ~ ".include 'libpaths.pasm'\n"
+    }
+  
+    method pir($source, *%adverbs) {
+        self.pirbegin() ~ $source.pir()
+    }
+
+    method evalpmc($source, *%adverbs) {
+        my $compiler := nqp::getcomp('PIR');
+        $compiler($source)
+    }
 }
 
 # Role specifying the default backend for this build.
@@ -103,7 +133,7 @@ class HLL::Compiler does HLL::Backend::Default {
         $!backend    := self.default_backend();
 
         # Default stages.
-        @!stages     := nqp::split(' ', 'start parse ast post pir evalpmc');
+        @!stages     := nqp::split(' ', 'start parse ast ' ~ $!backend.stages());
 
         # Command options and usage.
         @!cmdoptions := nqp::split(' ', 'e=s help|h target=s trace|t=s encoding=s output|o=s combine version|v show-config verbose-config|V stagestats=s? ll-exception rxtrace nqpevent=s profile profile-compile');
@@ -417,20 +447,50 @@ class HLL::Compiler does HLL::Backend::Default {
             return self.dumper($r, $target, |%adverbs);
         }
     }
+    
+    method exists_stage($stage) {
+        my $found := 0;
+        for self.stages() {
+            if $_ eq $stage {
+                return 1;
+            }
+        }
+        return 0;
+    }
 
-    method compile($source, *%adverbs) {
+    method compile($source, :$from, *%adverbs) {
         my %*COMPILING<%?OPTIONS> := %adverbs;
 
         my $target := nqp::lc(%adverbs<target>);
         my $result := $source;
         my $stderr := nqp::getstderr();
         my $stdin  := nqp::getstdin();
         my $stagestats := %adverbs<stagestats>;
+        unless $from eq '' || self.exists_stage($from) {
+            nqp::die("Unknown compilation input '$_'");
+        }
+        unless $target eq '' || self.exists_stage($target) {
+            nqp::die("Unknown compilation target '$_'");
+        }
         for self.stages() {
+            if $from ne '' {
+                if $_ eq $from {
+                    $from := '';
+                }
+                next;
+            }
             my $timestamp := nqp::time_n();
-            $result := self."$_"($result, |%adverbs);
+            if nqp::can(self, $_) {
+                $result := self."$_"($result, |%adverbs);
+            }
+            elsif nqp::can($!backend, $_) {
+                $result := $!backend."$_"($result, |%adverbs);
+            }
+            else {
+                nqp::die("Unknown compilation stage '$_'");
+            }
             my $diff := nqp::time_n() - $timestamp;
-            if nqp::defined($stagestats) {
+            if nqp::defined($stagestats) && $from eq '' {
                 nqp::printfh($stderr, nqp::sprintf("Stage %-11s: %7.3f", [$_, $diff]));
                 $!backend.force_gc() if nqp::bitand_i($stagestats, 0x4);
                 nqp::printfh($stderr, $!backend.vmstat())
@@ -472,32 +532,6 @@ class HLL::Compiler does HLL::Backend::Default {
         $ast;
     }
 
-    method post($source, *%adverbs) {
-        nqp::getcomp('QAST').post($source)
-    }
-
-    method pirbegin() {
-        ".include 'cclass.pasm'\n"
-        ~ ".include 'except_severity.pasm'\n"
-        ~ ".include 'except_types.pasm'\n"
-        ~ ".include 'iglobals.pasm'\n"
-        ~ ".include 'interpinfo.pasm'\n"
-        ~ ".include 'iterator.pasm'\n"
-        ~ ".include 'sysinfo.pasm'\n"
-        ~ ".include 'stat.pasm'\n"
-        ~ ".include 'datatypes.pasm'\n"
-        ~ ".include 'libpaths.pasm'\n"
-    }
-  
-    method pir($source, *%adverbs) {
-        self.pirbegin() ~ $source.pir()
-    }
-
-    method evalpmc($source, *%adverbs) {
-        my $compiler := nqp::getcomp('PIR');
-        $compiler($source)
-    }
-
     method dumper($obj, $name, *%options) {
         if nqp::can($obj, 'dump') {
             nqp::print($obj.dump());

src/NQP/World.pm

@@ -230,10 +230,9 @@ class NQP::World is HLL::World {
         my $stub_code := sub (*@args, *%named) {
             # Do the compilation.
             $past.unshift(self.libs());
-            my $nqpcomp  := nqp::getcomp('nqp');
-            my $post     := $nqpcomp.post(QAST::CompUnit.new( :hll('nqp'), $past ));
-            my $pir      := $nqpcomp.pir($post);
-            my $compiled := $nqpcomp.evalpmc($pir);
+            my $compiled := nqp::getcomp('nqp').compile(
+                QAST::CompUnit.new( :hll('nqp'), $past ),
+                :from<ast>);
 
             # Fix up any code objects holding stubs with the real compiled thing.
             my $c := nqp::elems($compiled);

t/qast/pirt.t

@@ -6,7 +6,7 @@ sub is_pirt_result($producer, $expected, $desc) {
     my $pirt := $producer();
     my $pir := $pirt.pir();
     #say($pir);
-    my $pbc := QAST::Compiler.evalpmc($pir);
+    my $pbc := nqp::getcomp('nqp').compile($pir, :from('pir'));
     ok($pbc() eq $expected, $desc);
 }
 

t/qast/qast.t

@@ -5,9 +5,7 @@ plan(73);
 # Following a test infrastructure.
 sub compile_qast($qast) {
     my $*QAST_BLOCK_NO_CLOSE := 1;
-    my $pirt := QAST::Compiler.as_post($qast);
-    my $pir := $pirt.pir();
-    QAST::Compiler.evalpmc($pir);
+    nqp::getcomp('nqp').compile($qast, :from('ast'));
 }
 sub is_qast($qast, $value, $desc) {
     try {