The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

#!/usr/bin/perl
# Copyright 2016 Jeffrey Kegler
# This file is part of Marpa::R3. Marpa::R3 is free software: you can
# redistribute it and/or modify it under the terms of the GNU Lesser
# General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# Marpa::R3 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
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser
# General Public License along with Marpa::R3. If not, see
use 5.010001;
use strict;
use English qw( -no_match_vars );
# This is a 'meta' tool, so I relax some of the
# restrictions I use to guarantee portability.
use autodie;
# I expect to be run from a subdirectory in the
# development heirarchy
use lib '../../../';
use lib '../../../../blib/arch';
my $verbose = 1;
my $help_flag = 0;
my $result = Getopt::Long::GetOptions(
'help' => \$help_flag,
);
die "usage $PROGRAM_NAME [--help] file ...\n" if $help_flag;
my $bnf = do { local $RS = undef; \(<>) };
my $ast = Marpa::R3::Internal::MetaAST->new($bnf);
my $parse_result = $ast->ast_to_hash();
sub sort_bnf {
my $cmp = $a->{lhs} cmp $b->{lhs};
return $cmp if $cmp;
my $a_rhs_length = scalar @{ $a->{rhs} };
my $b_rhs_length = scalar @{ $b->{rhs} };
$cmp = $a_rhs_length <=> $b_rhs_length;
return $cmp if $cmp;
for my $ix ( 0 .. ( $a_rhs_length - 1 ) ) {
$cmp = $a->{rhs}->[$ix] cmp $b->{rhs}->[$ix];
return $cmp if $cmp;
}
return 0;
} ## end sub sort_bnf
my %cooked_parse_result = (
xsy => $parse_result->{xsy},
character_classes => $parse_result->{character_classes},
symbols => $parse_result->{symbols},
discard_default_adverbs => $parse_result->{discard_default_adverbs},
lexeme_default_adverbs => $parse_result->{lexeme_default_adverbs},
first_lhs => $parse_result->{first_lhs},
start_lhs => $parse_result->{start_lhs},
);
my @rule_sets = keys %{ $parse_result->{rules} };
for my $rule_set (@rule_sets) {
my $aoh = $parse_result->{rules}->{$rule_set};
my $sorted_aoh = [ sort sort_bnf @{$aoh} ];
$cooked_parse_result{rules}->{$rule_set} = $sorted_aoh;
}
say "## The code after this line was automatically generated by ",
$PROGRAM_NAME;
say "## Date: ", scalar localtime();
$Data::Dumper::Sortkeys = 1;
print Data::Dumper->Dump( [ \%cooked_parse_result ], [qw(hashed_metag)] );
say "## The code before this line was automatically generated by ",
$PROGRAM_NAME;