mkparse

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