#!/usr/local/bin/perl
# $Id: mkparse,v 1.2 2002/03/25 07:39:46 gbarr Exp $
my($source,$dest) = @ARGV;
system qw(byacc -P),$source;
open(OUT, ">$dest") or die "Cannot open $dest: $!\n";
open(IN, "cpp y.tab.pl|");
%var = ();
%seen = ();
%state = ();
while(<IN>) {
  # In perl the stack size is not a problem
  next if /YYSTACKSIZE/;
  next if /^# \d+ "(.*?)"/ and $1 ne "parser.y";
  # Replace variables with constant subs
  if(s/^\$([A-Z][A-Z_0-9]*)\s*=\s*(\d+)\s*;/sub const$1 () { $2 }/) {
    $var{$1} = "const" . $1 . "()";
  }
  s/
    (\$([A-Z][A-Z_0-9]*))
   /
    exists $var{$2} ? $var{$2} : $1
  /xeg;
  # Comment out the id line
  s/^(?=\$yysccsid)/#/;
  # Use my variables
  s/^(\@yy\w+\s+=)/my $1/;
  # Make yyparse return $$ for the top terminal
  if (/^sub yyparse/ .. /^\}\s*#\s*yyparse/) {
    s/\breturn\(1\)/return undef/;
    s/\breturn\(0\)/return \$yyvs[\$yyvsp]/;
  }
  # Are we inside the switch statement ?
  my $ln = /^\s+switch:/ .. /^\s+\$yyssp -= \$yym;/;
  # Change all the if statements in the switch to labels
  if ( $ln ) {
    s/^if \(\$yyn == (\d+)\s*\)/State$1:/ and $state{"State$1"} = '';
  }
  # fix an uninit bug
  s/^(\s*)(?=\$yycheck\[\$yyn\]\s+==)/$1\$yyn <= \$#yycheck && /;
  print OUT;
  # Print the goto for the switch
  print OUT <<'ESQ' if $ln == 2;
my $label = "State$yyn";
goto $label if exists $yystate{$label};
last switch;
ESQ
}
# output table with names of labels that exist
my $states = '%yystate = (\'' . join("','",%state) . "');\n"; 
$states =~ s/(.{60,75},)/$1\n/g;
print OUT $states,"\n1;\n";
close OUT;
close IN;