Data commit

Task/Compiler-code-generator/Perl/compiler-code-generator.pl

@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+
+use strict;   # gen.pl - flatAST to stack machine code
+use warnings; # http://www.rosettacode.org/wiki/Compiler/code_generator
+
+my $stringcount = my $namecount = my $pairsym = my $pc = 0;
+my (%strings, %names);
+my %opnames = qw( Less lt LessEqual le Multiply mul Subtract sub Divide div
+  GreaterEqual ge Equal eq Greater gt NotEqual ne Negate neg );
+
+sub tree
+  {
+  my ($A, $B) = ( '_' . ++$pairsym, '_' . ++$pairsym ); # labels for jumps
+  my $line = <> // return '';
+  (local $_, my $arg) = $line =~ /^(\w+|;)\s+(.*)/ or die "bad input $line";
+  /Identifier/ ? "fetch [@{[ $names{$arg} //= $namecount++ ]}]\n" :
+    /Sequence/ ? tree() . tree() :
+    /Integer/  ? "push  $arg\n" :
+    /String/   ? "push  @{[ $strings{$arg} //= $stringcount++ ]}\n" :
+    /Assign/   ? join '', reverse tree() =~ s/fetch/store/r, tree() :
+    /While/    ? "$A:\n@{[ tree() ]}jz    $B\n@{[ tree() ]}jmp   $A\n$B:\n" :
+    /If/       ? tree() . "jz    $A\n@{[ !<> . # !<> skips second 'If'
+                  tree() ]}jmp   $B\n$A:\n@{[ tree() ]}$B:\n" :
+    /;/        ? '' :
+    tree() . tree() . ($opnames{$_} // lc) . "\n";
+  }
+
+$_ = tree() . "halt\n";
+
+s/^jmp\s+(\S+)\n(_\d+:\n)\1:\n/$2/gm;                # remove jmp next
+s/^(?=[a-z]\w*(.*))/                                 # add locations
+  (sprintf("%4d ", $pc), $pc += $1 ? 5 : 1)[0] /gem;
+my %labels = /^(_\d+):(?=(?:\n_\d+:)*\n *(\d+) )/gm; # pc addr of labels
+s/^ *(\d+) j(?:z|mp) *\K(_\d+)$/ (@{[                # fix jumps
+  $labels{$2} - $1 - 1]}) $labels{$2}/gm;
+s/^_\d+.*\n//gm;                                     # remove labels
+
+print "Datasize: $namecount Strings: $stringcount\n";
+print "$_\n" for sort { $strings{$a} <=> $strings{$b} } keys %strings;
+print;