#!/usr/bin/perl -w
# See copyright, etc in below POD section.
######################################################################
require 5.006_001;
use Getopt::Long;
use IO::File;
use Pod::Usage;
use strict;
use vars qw ($Debug $VERSION);
$VERSION = '3.420';
our $Self;
#======================================================================
# main
our $Opt_Debug;
our $Opt_Definitions;
our $Opt_File_Prefix;
our $Opt_Name_Prefix;
our $Opt_Output;
our $Opt_Token_Table;
our $Opt_Verbose;
our $Opt_Yacc = "bison";
our $Opt_Input;
autoflush STDOUT 1;
autoflush STDERR 1;
Getopt::Long::config ("no_auto_abbrev");
if (! GetOptions (
# Local options
"help" => \&usage,
"version" => sub { print "Version $VERSION\n"; exit(0); },
"yacc=s" => \$Opt_Yacc,
# Passed to Bison
"t|debug" => sub { $Opt_Debug = 1; },
"b|file-prefix=s" => \$Opt_File_Prefix,
"d" => \$Opt_Definitions,
"k|token-table" => \$Opt_Token_Table,
"o=s" => \$Opt_Output,
"p|name-prefix=s" => \$Opt_Name_Prefix,
"v|verbose" => \$Opt_Verbose,
"<>" => \¶meter,
)) {
die "%Error: Bad usage, try 'bisonpre --help'\n";
}
$Opt_Input or die "bisonpre: %Error: input file not specified\n";
$Opt_Output or die "bisonpre: %Error: --o option is required\n";
process();
#----------------------------------------------------------------------
sub usage {
print "Version $VERSION\n";
pod2usage(-verbose=>2, -exitval=>2, -output=>\*STDOUT, -noperldoc=>1);
exit (1);
}
sub parameter {
my $param = shift;
if (!defined $Opt_Input) {
$Opt_Input = $param;
} else {
die "bisonpre: %Error: Unknown parameter: $param\n";
}
}
#######################################################################
sub process {
remove_outputs();
$Self->{bison_version} = bison_version_check();
my $supports_report = ($Self->{bison_version} >= 2.3);
clean_input($Opt_Input, tmp_prefix().".y");
# Run bison
my $command = ($Opt_Yacc
.($Opt_Debug?" -t":"")
.($Opt_Definitions?" -d":"")
.($Opt_Token_Table?" -k":"")
.($Opt_Verbose?" -v":"")
.(($Opt_Verbose && $supports_report)?" --report=itemset --report=lookahead":"")
# -p required for GLR parsers; they write to -p basename, not -o
.($Opt_Name_Prefix?" -p $Opt_Name_Prefix":"")
." -b ".tmp_prefix()
." -o ".tmp_prefix().".c"
." ".tmp_prefix().".y" );
print " $command\n";
system $command;
my $status = $?;
if ($status != 0) {
remove_outputs();
my $v = bison_version_check();
die "bisonpre: %Error: $Opt_Yacc version $v run failed due to errors\n";
}
clean_output(tmp_prefix().".output",output_prefix().".output", 1,0);
warning_check(output_prefix().".output");
clean_output(tmp_prefix().".c", output_prefix().".c", 0,1);
clean_output(tmp_prefix().".h", output_prefix().".h", 0,1);
remove_tmp();
}
sub tmp_prefix {
return output_prefix()."_pretmp";
}
sub output_prefix {
my $o;
if ($Opt_Output) {
(my $o = $Opt_Output) =~ s!\.[^.]*$!!;
return $o;
} else {
return $Opt_File_Prefix.".tab";
}
}
sub remove_tmp {
unlink(tmp_prefix().".c"); # Ok if errors
unlink(tmp_prefix().".h"); # Ok if errors
unlink(tmp_prefix().".output"); # Ok if errors
}
sub remove_outputs {
remove_tmp();
unlink(output_prefix().".c"); # Ok if errors
unlink(output_prefix().".h"); # Ok if errors
# We don't remove .output file, as it's useful for debugging errors
}
sub bison_version_check {
my $v = `$Opt_Yacc --version`;
if ($v && $v =~ /([0-9]+\.[0-9]+)/) {
my $v = $1;
($v >= 1.875) or die "bisonpre: %Error: '$Opt_Yacc' is version $v; version 1.875 or newer is required\n";
return $v;
} else {
die "bisonpre: %Error: '$Opt_Yacc' is not installed, or not working\n";
}
}
sub clean_output {
my $filename = shift;
my $outname = shift || $filename;
my $is_output = shift;
my $is_c = shift;
print " edit $filename $outname\n";
my $fh = IO::File->new("<$filename") or die "%Error: $! $filename\n";
my @lines = $fh->getlines;
$fh->close;
(my $basename = tmp_prefix().".") =~ s!.*/!!;
$basename = quotemeta($basename);
(my $newbase = $Opt_Input) =~ s!.*/!!;
$newbase =~ s/\.y/./;
if ($is_output) {
my %state_line; my $l=0;
foreach my $line (@lines) {
$l++;
# We add a colon so it's easy to search for the definition
$state_line{$1} = $l if $line =~ s/^state (\d+)\s*$/state $1:/;
}
my @out;
foreach my $line (@lines) {
if ($line =~ /^State (\d+) (conflicts)/) {
chomp $line;
$line .= " // line $state_line{$1}" if $state_line{$1};
$line .= "\n";
}
push @out, $line;
}
@lines = @out; @out = ();
}
if ($is_c) {
my %token_values;
my $in_en=0;
foreach my $line (@lines) {
$in_en=1 if $line =~ /enum\s+yytokentype/;
$in_en=0 if $line =~ /;/;
$token_values{$2} = $1 if $in_en && $line =~ /\b(\S+) = (\d+)/;
}
my @out;
foreach my $line (@lines) {
if ($line =~ /BISONPRE_TOKEN_NAMES/) {
push @out, $line;
foreach my $tv (sort keys %token_values) {
push @out, sprintf("\tcase %d: return \"%s\";\n",
$tv, $token_values{$tv});
}
next;
}
push @out, $line;
}
@lines = @out; @out = ();
}
$fh = IO::File->new(">$outname") or die "%Error: $! writing $outname\n";
foreach my $line (@lines) {
# Fix filename refs
$line =~ s!$basename!$newbase!g;
# Fix bison 2.3 and GCC 4.2.1
$line =~ s!\(YY_\("!(YY_((char*)"!g;
# Fix bison 2.3 glr-parser warning about yyerrorloc.YYTYPE::yydummy uninit
$line =~ s!(YYLTYPE yyerrloc;)!$1 yyerrloc.yydummy=0;/*bisonpre*/!g;
$fh->write($line);
}
$fh->close;
}
sub warning_check {
my $filename = shift;
my $fh = IO::File->new("<$filename") or die "%Error: $! $filename\n";
while (defined(my $line = $fh->getline)) {
if ($line =~ /(conflicts|warning:|^useless)/i) {
die "%Error: $filename:$.: $line\n";
}
}
$fh->close;
}
#######################################################################
sub clean_input {
my $filename = shift;
my $outname = shift || $filename; # Can == filename if desired
print " edit $filename $outname\n";
$Self->{filename} = $filename;
my $fh = IO::File->new("<$filename") or die "%Error: $! $filename\n";
my @lines = $fh->getlines;
$fh->close;
# Find "%tokens<type>:"
# Find "rule<type>:" and replace with just "rule:"
my %types;
my %rules; $Self->{rules} = \%rules;
my %tokens;
my $last_rule;
my $section = 1;
{
my @linesin = @lines; @lines=(); my $l=0;
foreach my $line (@linesin) {
$l++;
# ^/ to prevent comments from matching
$line =~ m!^[a-zA-Z0-9_<>]+:[^/]*[a-zA-Z]! and die "%Error: $filename:$l: Move text on rule line to next line: $line\n";
if ($line =~ /^%%/) {
$section++;
if ($section==2) { $last_rule = undef; }
}
elsif ($line =~ s/^([a-zA-Z0-9_]+)<(\S*)>:/$1:/) {
!$rules{$1}{name} or die "%Error: $filename:$l: Redeclaring '$1': $line\n";
$types{$2}{$1} = 1;
$rules{$1}{name} = $1;
$rules{$1}{type} = $2;
!$last_rule or die "%Error: $filename:$l: Unterminated previous rule\n";
$last_rule = $1;
} elsif ($line =~ /^([a-zA-Z0-9_]+):/) {
!$rules{$1}{name} or die "%Error: $filename:$l: Redeclaring '$1': $line\n";
$rules{$1}{name} = $1;
$rules{$1}{type} = "";
!$last_rule or die "%Error: $filename:$l: Unterminated previous rule\n";
$last_rule = $1;
}
push @lines, $line;
# Now clean the line and extract some more info
(my $cline = $line) =~ s/\/\/.*$/\n/;
(my $rline = $line) =~ s/\/\/.*$/\n/;
if ($cline =~ /^\s*;/) {
$last_rule or die "%Error: $filename:$l: Stray semicolon\n";
$last_rule = undef;
} elsif ($last_rule) {
$rules{$last_rule}{rules_and_productions} .= $cline;
}
if ($cline =~ /^%token\s*<(\S+)>\s*(\S+)/) {
!$tokens{$2} or die "%Error: $filename:$l: Redeclaring '$2': $line\n";
$tokens{$2} = $1;
}
foreach my $tok (split /[^a-zA-Z0-9_]+/, $cline) {
if ($last_rule && $tok=~/^[a-zA-Z]/) {
#print "TT $last_rule $tok\n";
$rules{$last_rule}{subrules}{$tok} = 1;
$rules{$tok}{parentrules}{$last_rule} = 1;
}
}
}
}
#use Data::Dumper; print Dumper(\%rules);
# Replace BISONPRE_VERSION(ver,,...) with expanded list
{
my @linesin = @lines; @lines=(); my $l=0;
foreach my $line (@linesin) {
$l++;
if ($line =~ /BISONPRE_VERSION/) {
# 1 3 4
($line =~ /BISONPRE_VERSION\((\S+)\s*,\s*((\S+)\s*,)?\s*([^\),]+)\)\s*$/)
or die "%Error: $filename:$l: Bad form of BISONPRE_VERSION: $line\n";
my $ver=$1; my $ver_max=$3; my $cmd=$4;
if ($Self->{bison_version} >= $1
&& (!$ver_max || $Self->{bison_version} <= $ver_max)) {
$line = $cmd."\n";
} else {
$line = "//NOP: $line";
}
}
push @lines, $line;
}
}
# Replace BISONPRE_NOT(type,...) with expanded list
{
my @linesin = @lines; @lines=(); my $l=0;
foreach my $line (@linesin) {
$l++;
if ($line =~ /BISONPRE_NOT/) {
($line =~ s/BISONPRE_NOT\((\S+)\)\s*({[^}]+})\s*$//)
or die "%Error: $filename:$l: Bad form of BISONPRE_NOT: $line\n";
my $endtok = $1; my $action = $2;
my @endtoks = split (/,/, $endtok);
map { $tokens{$_} or die "%Error: $filename:$l: Can't find definition for token: $_\n"
} @endtoks;
# Push it all onto one line to avoid error messages changing
my $bar = "";
tok:
foreach my $tok (sort keys %tokens) {
foreach (@endtoks) {
next tok if $tok eq $_;
}
if ($endtok ne $tok) {
$line .= "\t$bar $tok $action";
$bar = "|";
}
}
$line .= "\n";
}
push @lines, $line;
}
}
# Replace BISONPRE_COPY(type,{code})
{
my @linesin = @lines; @lines=(); my $l=0;
foreach my $line (@linesin) {
$l++;
if ($line =~ /BISONPRE_COPY/) {
$line = _bisonpre_copy($line,$l,0);
}
push @lines, $line;
}
}
# Replace ~[x]~ - must be after BISONPRE_COPY expansion
{
my @linesin = @lines; @lines=(); my $l=0;
foreach my $line (@linesin) {
$l++;
$line =~ s/~[a-zA-Z0-9_]+~//g;
push @lines, $line;
}
}
# Find "BISONPRE_TYPES"
{
my @linesin = @lines; @lines=(); my $l=0;
my $needmore = 0;
foreach my $line (@linesin) {
$l++;
if ($line =~ m!//BISONPRE_TYPES!) {
push @lines, $line;
foreach my $type (sort keys %types) {
next if !$type;
my $line = "%type<$type>\t";
foreach my $rule (sort keys %{$types{$type}}) {
$line.=" ".$rule;
}
$line .= "\n";
push @lines, $line;
$needmore++
}
} elsif ($needmore) {
# Bison doesn't have a #line directive, so we need somewhere to insert into
$line =~ s!^\s*//.*$!!;
($line =~ m/^\s*$/) or die "%Error: $filename:$l: Need $needmore more blank lines to insure line numbers are constant\n";
$needmore--;
} else {
push @lines, $line;
}
}
}
$fh = IO::File->new(">$outname") or die "%Error: $! writing $outname\n";
foreach my $line (@lines) {
$fh->write($line);
}
$fh->close;
}
sub _bisonpre_copy {
my $text = shift;
my $l = shift;
my $depth = shift;
while ($text =~ /BISONPRE_COPY/) {
($text =~ s/BISONPRE_COPY(_ONCE)?\((\S+)\s*,\s*{([^}]*)}\s*\)/{HERE}/)
or die "%Error: $Self->{filename}:$l: Bad form of BISONPRE_NOT: $text\n";
my $once = $1; my $rule = $2; my $code = $3;
$Self->{rules}{$rule} or die "%Error: $Self->{filename}:$l: Can't find definition for rule: $rule\n";
if ($depth > 0 && $once) {
# _ONCE means don't inherit
$text =~ s/\|[ \t]+{HERE}//; # Don't OR in nothing
$text =~ s/{HERE}//;
} else {
# Push it all onto one line to avoid error messages changing
my $insert = $Self->{rules}{$rule}{rules_and_productions};
$insert =~ s/^\S+://g; # Strip rule name
# Recurse so BISONPRE under B
#print "COPY $l code $code\n";
#print "COPY $l in $insert\n";
$_=$insert; eval("$code; \$_;"); $insert = $_;
#print "COPY $l out $insert\n";
while ($insert =~ s/[ \t\n]+\n/\n/go) {}
while ($insert =~ s/\n/ /go) {} # Optional - preserve line numbering
$text =~ s/{HERE}/$insert/;
}
$depth++;
}
return $text;
}
#######################################################################
__END__
=pod
=head1 NAME
bisonpre - Bison wrapper with pre and post processing
=head1 SYNOPSIS
bisonpre --yacc bison --debug --verbose --defines X.h -k $< -pX -o X.c
=head1 DESCRIPTION
Bisonpre is a wrapper for the Bison YACC replacement. Input to Bison is
preprocessed with substitution as described below under EXTENSIONS. Output
from Bison is checked for additional errors, and corrected to work around
various compile warnings.
=head1 EXTENSIONS
=over 4
=item //BISONPRE_TYPES
This is expanded into %type declarations.
=item ~[a-z]+~
Any text matching ~[a-z]+~ is removed. This allows optional text to be
used only when the rule containing the ~~ is used in a BISONPRE_COPY.
=item rule_label<type>:
This allows the label declaring a rule to also specify the type of the
rule. The type will be inserted where /*BISONPRE_TYPES*/ is encountered.
=item BISONPRE_COPY(rule, {code})
Copy the rules and productions from the specified rule, filter through the
Perl code provided in the {} and insert here into the output file.
=item BISONPRE_COPY_ONCE(rule, {code})
As with BISONPRE_COPY, but if called from underneath another BISONPRE_COPY
rule, ignore it.
=item BISONPRE_NOT(token[, token...])
Create a rule that matches every token except for those specified.
=item BISONPRE_VERSION(ver, cmd)
If the bison version is >= the specified version, include the given command.
=back
=head1 ARGUMENTS
=over 4
=item -b file-prefix
=item --file-prefix=file-prefix
Passed to bison.
Specify a prefix to use for all bison output file names. The names are
chosen as if the input file were named file-prefix.c.
=item -d
Passed to bison.
Write an extra output file containing macro definitions for the token type
names defined in the grammar and the semantic value type YYSTYPE, as well
as a few extern variable declarations. If the parser output file is named
name.c then this file is named name.h. This output file is essential if
you wish to put the definition of yylex in a separate source file, because
yylex needs to be able to refer to token type codes and the variable
yylval.
=item --help
Displays this message and program version and exits.
=item -k
=item --token-table
Passed to bison.
This switch causes the name.tab.c output to include a list of token names
in order by their token numbers; this is defined in the array yytname.
Also generated are #defines for YYNTOKENS, YYNNTS, YYNRULES, and YYNSTATES.
=item -t
=item --debug
Passed to bison.
In the parser file, define the macro YYDEBUG to 1 if it is not already
defined, so that the debugging facilities are compiled.
=item -v
=item --verbose
Passed to bison.
Write an extra output file containing verbose descriptions of the parser
states and what is done for each type of look-ahead token in that state.
This file also describes all the conflicts, both those resolved by operator
precedence and the unresolved ones. The file's name is made by removing
.tab.c or .c from the parser output file name, and adding .output instead.
Therefore, if the input file is foo.y, then the parser file is called
foo.tab.c by default. As a consequence, the verbose output file is called
foo.output.
=item --version
Print the version number and exit.
=item --yacc
Specify the name of the bison executable, defaults to "bison."
=back
=head1 DISTRIBUTION
This is part of the L<http://www.veripool.org/> free Verilog EDA software
tool suite. The latest version is available from CPAN and from
L<http://www.veripool.org/>.
Copyright 2008-2016 by Wilson Snyder. This package is free software; you
can redistribute it and/or modify it under the terms of either the GNU
Lesser General Public License Version 3 or the Perl Artistic License Version 2.0.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
more details.
=head1 AUTHORS
Wilson Snyder <wsnyder@wsnyder.org>
=head1 SEE ALSO
C<bison>
=cut
######################################################################
### Local Variables:
### compile-command: "./bisonpre "
### End: