The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use strict;
package Emit::Perl5;
use Data::Dumper;
my $debugging = $ARGV[0];
use YAML;
sub emit {
	my $out = '';
	while (my ($node,$args) = each %{$_[0]}) {
		print "$_[1]:emit($node,".Dumper($args).")\n" if $debugging;
		no strict 'refs';
		my $resault = $Emit::Perl5::{$node}->($args);
		print "code($out) .= $resault\n" if $debugging > 2;
		$out .= $resault;
	}
	return $out;
}
sub if {
	my $body = emit($_[0]{block},'if{block}');
	my $exp = emit($_[0]{exp},'if{exp}');
	return "if ($exp) {$body}";
}
sub num {
	return $_[0]+0;
}
sub scalar {
	return $_[0];
}
sub double_quoted {
	return $_[0];
}
sub while {
	my $body = emit($_[0]{block});
	my $exp = emit($_[0]{exp});
	return "while ($exp) {$body}";
}
my $statements=0;
sub statements {
	return join ';',map {emit($_,"statement$statements")} @{$_[0]};
}

our %op1;

$op1{'+'} = sub {
	my $exp1 = emit($_[0]{exp1},'infix:<+> exp1');
	my $exp2 = emit($_[0]{exp2},'infix:<+> exp2');
	return "$exp1 + $exp2";
};
$op1{'/'} = sub {
	my $exp1 = emit($_[0]{exp1});
	my $exp2 = emit($_[0]{exp2});
	return "$exp1 / $exp2";
};

sub expression {
	$op1{$_[0]{op1}}->($_[0]);
}





#the ast is hand modified to contain an expresion node
use Data::Dumper;
$Data::Dumper::Indent = 1;

print q{example 1: if (1) {10+$a/"abc"}},"\n";
print emit(Load(<<'...'), 'main');
---
statements:
  - if:
      block:
        statements:
          - expression:
              exp1:
                  num: 10
              exp2:
                expression:
                  exp1:
                    scalar: '$a '
                  exp2:
                    double_quoted: '"abc"'
                  op1: /
              op1: +
      exp:
        num: 1
...

print "\nexample 2:1\n";
print emit(Load(<<'...'), 'main');
---
statements:
  - num: 1
...