diff options
Diffstat (limited to 'lib/Compiler.pm')
-rw-r--r-- | lib/Compiler.pm | 65 |
1 files changed, 65 insertions, 0 deletions
diff --git a/lib/Compiler.pm b/lib/Compiler.pm new file mode 100644 index 0000000..23fad01 --- /dev/null +++ b/lib/Compiler.pm @@ -0,0 +1,65 @@ +package Compiler; +use strict; +use warnings; +use Tree::Transform::XSLTish; + +default_rules; + +tree_rule match => '/', action => sub { + my $prog=<<'PROG'; +#!/usr/bin/perl +use strict; +use warnings; +PROG + $prog.=$_ for $_[0]->apply_rules; + return $prog; +}; + +tree_rule match => 'line[@label]', action => sub { + return $_[0]->it->attributes->{label}.': '.(($_[0]->apply_rules)[0]); +}; + +tree_rule match => 'assign', action => sub { + my ($var)=$_[0]->apply_rules($_[0]->engine->findnodes('var',$_[0]->it)); + my ($value)=$_[0]->apply_rules($_[0]->engine->findnodes('*[name()!="var"]',$_[0]->it)); + + return "$var = $value;\n"; +}; + +tree_rule match => 'if', action => sub { + my ($guard,$then,$else)=map {$_[0]->engine->findnodes($_,$_[0]->it)} + qw(guard then else); + + ($guard)=$_[0]->apply_rules($guard); + ($then,$else)=map {$_->attributes->{label}} $then,$else; + + return "if ($guard) { goto $then } else { goto $else }\n"; +}; + +tree_rule match => 'goto', action => sub { + return 'goto '.$_[0]->it->attributes->{label}.";\n"; +}; + +tree_rule match => 'print', action => sub { + return 'print '.(join '',$_[0]->apply_rules).";\n"; +}; + +tree_rule match => 'var', action => sub { + return '$'.$_[0]->it->attributes->{name}; #' +}; + +sub joiner { + my $j=$_[0]; + return sub { + join $j,$_[0]->apply_rules; + } +} + +tree_rule match => 'add', action => joiner('+'); +tree_rule match => 'mult', action => joiner('*'); + +tree_rule match => 'const', action => sub { + return $_[0]->it->attributes->{value}; +}; + +1; |