Refactor compile nanopasses into a more suitable structure

lib/Language/Bel/Compiler.pm

@@ -4,30 +4,37 @@ use 5.006;
 use strict;
 use warnings;
 
-use Language::Bel::Compiler::Pass01 qw(
-    nanopass_01_alpha
-);
-use Language::Bel::Compiler::Pass02 qw(
-    nanopass_02_flatten
-);
-use Language::Bel::Compiler::Pass03 qw(
-    nanopass_03_allocate_registers
-);
+use Language::Bel::Compiler::Pass::AllocateRegisters;
+use Language::Bel::Compiler::Pass::Alpha;
+use Language::Bel::Compiler::Pass::Flatten;
 use Language::Bel::Compiler::Generator qw(
     generate_bytefunc
 );
 
 use Exporter 'import';
 
+sub make_pass {
+    my ($name) = @_;
+
+    return "Language::Bel::Compiler::Pass::$name"->new();
+}
+
+my @PASSES = map { make_pass($_) } qw<
+    Alpha
+    Flatten
+    AllocateRegisters
+>;
+
 sub compile {
     my ($source) = @_;
 
-    my $_00 = read_whole($source);
-    my $_01 = nanopass_01_alpha($_00);
-    my $_02 = nanopass_02_flatten($_01);
-    my $_03 = nanopass_03_allocate_registers($_02);
+    my $program = read_whole($source);
+
+    for my $nanopass (@PASSES) {
+        $program = $nanopass->translate($program);
+    }
 
-    return generate_bytefunc($_03);
+    return generate_bytefunc($program);
 }
 
 our @EXPORT_OK = qw(

lib/Language/Bel/Compiler/Pass.pm

@@ -0,0 +1,24 @@
+package Language::Bel::Compiler::Pass;
+
+use 5.006;
+use strict;
+use warnings;
+
+sub new {
+    my ($class, $name) = @_;
+
+    return bless({
+        name => $name,
+    }, $class);
+}
+
+# abstract
+sub translate {
+    my ($self) = @_;
+
+    my $name = $self->{name};
+
+    die "The [$name] pass doesn't implement a 'translate' method";
+}
+
+1;

lib/Language/Bel/Compiler/Pass03.pm → lib/Language/Bel/Compiler/Pass/AllocateRegisters.pm

@@ -1,4 +1,5 @@
-package Language::Bel::Compiler::Pass03;
+package Language::Bel::Compiler::Pass::AllocateRegisters;
+use base qw(Language::Bel::Compiler::Pass);
 
 use 5.006;
 use strict;
@@ -18,7 +19,11 @@ use Language::Bel::Compiler::Primitives qw(
     cdr
 );
 
-use Exporter 'import';
+sub new {
+    my ($class) = @_;
+
+    return $class->SUPER::new("allocate-registers");
+}
 
 sub substitute_registers {
     my ($expr) = @_;
@@ -37,8 +42,8 @@ sub substitute_registers {
     }
 }
 
-sub nanopass_03_allocate_registers {
-    my ($ast) = @_;
+sub translate {
+    my ($self, $ast) = @_;
 
     $ast = cdr($ast);
     my $args = substitute_registers(car($ast));
@@ -54,8 +59,4 @@ sub nanopass_03_allocate_registers {
     );
 }
 
-our @EXPORT_OK = qw(
-    nanopass_03_allocate_registers
-);
-
 1;

lib/Language/Bel/Compiler/Pass01.pm → lib/Language/Bel/Compiler/Pass/Alpha.pm

@@ -1,4 +1,5 @@
-package Language::Bel::Compiler::Pass01;
+package Language::Bel::Compiler::Pass::Alpha;
+use base qw(Language::Bel::Compiler::Pass);
 
 use 5.006;
 use strict;
@@ -24,7 +25,11 @@ use Language::Bel::Compiler::Gensym qw(
     gensym
 );
 
-use Exporter 'import';
+sub new {
+    my ($class) = @_;
+
+    return $class->SUPER::new("alpha");
+}
 
 sub replace_variables {
     my ($ast, $translation_ref) = @_;
@@ -43,8 +48,8 @@ sub replace_variables {
     }
 }
 
-sub nanopass_01_alpha {
-    my ($ast) = @_;
+sub translate {
+    my ($self, $ast) = @_;
 
     $ast = cdr($ast);
     my $fn_name = car($ast);
@@ -81,8 +86,4 @@ sub nanopass_01_alpha {
     );
 }
 
-our @EXPORT_OK = qw(
-    nanopass_01_alpha
-);
-
 1;

lib/Language/Bel/Compiler/Pass02.pm → lib/Language/Bel/Compiler/Pass/Flatten.pm

@@ -1,4 +1,5 @@
-package Language::Bel::Compiler::Pass02;
+package Language::Bel::Compiler::Pass::Flatten;
+use base qw(Language::Bel::Compiler::Pass);
 
 use 5.006;
 use strict;
@@ -28,13 +29,17 @@ use Language::Bel::Compiler::Primitives qw(
     cdr
 );
 
-use Exporter 'import';
-
 my %arg_count_of = (
     "id" => 2,
     "type" => 1,
 );
 
+sub new {
+    my ($class) = @_;
+
+    return $class->SUPER::new("flatten");
+}
+
 sub is_primitive {
     my ($op) = @_;
 
@@ -130,8 +135,8 @@ sub listify {
     return $list;
 }
 
-sub nanopass_02_flatten {
-    my ($ast) = @_;
+sub translate {
+    my ($self, $ast) = @_;
 
     $ast = cdr($ast);
     # skipping $fn_name
@@ -166,8 +171,4 @@ sub nanopass_02_flatten {
     );
 }
 
-our @EXPORT_OK = qw(
-    nanopass_02_flatten
-);
-
 1;