#!/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 # http://www.gnu.org/licenses/. use 5.010001; use strict; use warnings; use English qw( -no_match_vars ); use Data::Dumper; # 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'; use Marpa::R3; use Getopt::Long; 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;