+sub help ($)
+{
+ my ($verbose) = @_;
+ use Pod::Usage;
+ # See <URL:http://perldoc.perl.org/pod2man.html#NOTES>.
+ pod2usage( { -message => "Bench Bison parsers",
+ -exitval => 0,
+ -verbose => $verbose,
+ -output => \*STDOUT });
+}
+
+######################################################################
+
+# The end of the directives to parse.
+my $eod = "end of directives";
+# The list of tokens parsed by the following functions.
+my @token;
+
+# eat ($EXPECTED)
+# ---------------
+# Check that the current token is $EXPECTED, and move to the next.
+sub eat ($)
+{
+ my ($expected) = @_;
+ die "expected $expected, unexpected: $token[0] (@token)\n"
+ unless $token[0] eq $expected;
+ shift @token;
+}
+
+# Parse directive specifications:
+# expr: term (| term)*
+# term: fact (& fact)*
+# fact: ( expr ) | [ expr ] | dirs
+# dirs: %s SKELETON | #d NAME[=VALUE] | %d NAME[=VALUE] | directive
+sub parse (@)
+{
+ @token = (@_, $eod);
+ verbose 3, "Parsing: @token\n";
+ my @res = parse_expr ();
+ eat ($eod);
+ return @res;
+}
+
+sub parse_expr ()
+{
+ my @res = parse_term ();
+ while ($token[0] eq '|')
+ {
+ eat ('|');
+ # Alternation.
+ push @res, parse_term ();
+ }
+ return @res;
+}
+
+sub parse_term ()
+{
+ my @res = parse_fact ();
+ while ($token[0] eq '&')
+ {
+ eat ('&');
+ # Cartesian product.
+ my @lhs = @res;
+ @res = ();
+ for my $rhs (parse_fact ())
+ {
+ for my $lhs (@lhs)
+ {
+ push @res, $lhs . ($lhs && $rhs ? "\n" : "") . $rhs;
+ }
+ }
+ }
+ return @res;
+}
+
+sub parse_fact ()
+{
+ my @res;
+ die "unexpected end of expression"
+ unless defined $token[0];
+
+ if ($token[0] eq '(')
+ {
+ eat ('(');
+ @res = parse_expr ();
+ eat (')');
+ }
+ elsif ($token[0] eq '[')
+ {
+ eat ('[');
+ @res = (parse_expr (), '');
+ eat (']');
+ }
+ else
+ {
+ @res = parse_dirs ();
+ }
+ return @res;
+}
+
+sub parse_dirs ()
+{
+ my @res;
+ die "unexpected end of expression"
+ unless defined $token[0];
+
+ if ($token[0] eq '#d')
+ {
+ eat ('#d');
+ $token[0] =~ s/(.*?)=(.*)/$1 $2/;
+ @res = ("%code {\n#define $token[0]\n}");
+ shift @token;
+ }
+ elsif ($token[0] eq '%d')
+ {
+ shift @token;
+ $token[0] =~ s/(.*?)=(.*)/$1 "$2"/;
+ @res = ("%define $token[0]");
+ shift @token;
+ }
+ elsif ($token[0] eq '%s')
+ {
+ shift @token;
+ @res = ("%skeleton \"$token[0]\"");
+ shift @token;
+ }
+ else
+ {
+ @res = $token[0];
+ shift @token;
+ }
+
+ return @res;
+}
+
+######################################################################
+
+sub getopt ()
+{
+ use Getopt::Long;
+ my %option = (
+ "b|bench=s" => \$bench,
+ "c|cflags=s" => \$cflags,
+ "d|directive=s" => \@directive,
+ "g|grammar=s" => \$grammar,
+ "h|help" => sub { help ($verbose) },
+ "i|iterations=i" => \$iterations,
+ "q|quiet" => sub { --$verbose },
+ "v|verbose" => sub { ++$verbose },
+ );
+ Getopt::Long::Configure ("bundling", "pass_through");
+ GetOptions (%option)
+ or exit 1;
+}
+
+######################################################################
+
+getopt;
+
+# Create the directory we work in.
+mkdir "benches" or die "cannot create benches"
+ unless -d "benches";
+my $count = 1;
+++$count
+ while -d "benches/$count";
+my $dir = "benches/$count";
+mkdir $dir
+ or die "cannot create $dir";
+chdir $dir
+ or die "cannot chdir $dir";
+
+# The following message is tailored to please Emacs' compilation-mode.
+verbose 1, "Entering directory `$dir'\n";
+verbose 1, "Using bison=$bison.\n";
+verbose 2, "Using cc=$cc.\n";
+verbose 2, "Using cxx=$cxx.\n";
+verbose 2, "Using cflags=$cflags.\n";
+verbose 2, "Grammar: $grammar\n";
+
+
+# Support -b: predefined benches.
+my %bench =
+ (
+ "push" => \&bench_push_parser,
+ "variant" => \&bench_variant_parser,
+ );
+
+if (defined $bench)
+{
+ die "invalid argument for --bench: $bench"
+ unless defined $bench{$bench};
+ &{$bench{$bench}}();
+ exit 0;
+}
+else
+{
+ # Launch the bench marking.
+ bench ($grammar, @ARGV);
+}
projects / bison.git / blobdiff