#!/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;