File Coverage

blib/lib/Marpa/R2/MetaAST.pm

Criterion	Covered	Total	%
statement	827	977	84.6
branch	177	280	63.2
condition	68	105	64.7
subroutine	103	112	91.9
pod			n/a
total	1175	1474	79.7

# Copyright 2022 Jeffrey Kegler
# This file is part of Marpa::R2.  Marpa::R2 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::R2 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::R2.  If not, see
# http://www.gnu.org/licenses/.

package Marpa::R2::MetaAST;

use 5.010001;
use strict;
use warnings;

use vars qw($VERSION $STRING_VERSION);
$VERSION        = '13.002_000';
$STRING_VERSION = $VERSION;
## no critic(BuiltinFunctions::ProhibitStringyEval)
$VERSION = eval $VERSION;
## use critic

package Marpa::R2::Internal::MetaAST;

use English qw( -no_match_vars );

sub new {
    my ( $class, $p_rules_source ) = @_;
    my $meta_recce = Marpa::R2::Internal::Scanless::meta_recce();
    eval { $meta_recce->read($p_rules_source) }
        or Marpa::R2::exception( "Parse of BNF/Scanless source failed\n",
        $EVAL_ERROR );
    if ( my $ambiguity_status = $meta_recce->ambiguous() ) {
        Marpa::R2::exception( "Parse of BNF/Scanless source failed:\n",
            $ambiguity_status );
    }
    my $value_ref = $meta_recce->value();
    Marpa::R2::exception('Parse of BNF/Scanless source failed')
        if not defined $value_ref;
    my $ast = { meta_recce => $meta_recce, top_node => ${$value_ref} };
    return bless $ast, $class;
} ## end sub new

sub Marpa::R2::Internal::MetaAST::Parse::substring {
    my ( $parse, $start, $length ) = @_;
    my $meta_slr      = $parse->{meta_recce};
    my $thin_meta_slr = $meta_slr->[Marpa::R2::Internal::Scanless::R::C];
    my $string        = $thin_meta_slr->substring( $start, $length );
    chomp $string;
    return $string;
} ## end sub Marpa::R2::Internal::MetaAST::Parse::substring

sub ast_to_hash {
    my ($ast) = @_;
    my $hashed_ast = {};

    $hashed_ast->{meta_recce} = $ast->{meta_recce};
    bless $hashed_ast, 'Marpa::R2::Internal::MetaAST::Parse';

    $hashed_ast->{current_lexer} = 'L0';
    $hashed_ast->{rules}->{G1} = [];
    my $g1_symbols = $hashed_ast->{symbols}->{G1} = {};

    my ( undef, undef, @statements ) = @{ $ast->{top_node} };

    # This is the last ditch exception catcher
    # It forces all Marpa exceptions to be die's,
    # then catches them and rethrows using Carp.
    #
    # The plan is to use die(), with higher levels
    # catching and re-die()'ing after adding
    # helpful location information.  After the
    # re-throw it is caught here and passed to
    # Carp.
    my $eval_ok = eval {
        local $Marpa::R2::JUST_DIE = 1;
        $_->evaluate($hashed_ast) for @statements;
        1;
    };
    Marpa::R2::exception($EVAL_ERROR) if not $eval_ok;

    my %grammars = ();
    $grammars{$_} = 1 for keys %{ $hashed_ast->{rules} };
    my @lexers =
        grep { ( substr $_, 0, 1 ) eq 'L' } keys %grammars;

    for my $lexer (@lexers) {
        my $lexer_name = $lexer;
        NAME_LEXER: {
            if ( $lexer eq 'L0' ) {
                $lexer_name = "L0 (the default)";
                last NAME_LEXER;
            }
            last NAME_LEXER if ( substr $lexer_name, 0, 2 ) ne 'L-';
            $lexer_name = substr $lexer_name, 2;
        } ## end NAME_LEXER:
    } ## end for my $lexer (@lexers)

    my %stripped_character_classes = ();
    {
        my $character_classes = $hashed_ast->{character_classes};
        for my $symbol_name ( sort keys %{$character_classes} ) {
            my ($re) = @{ $character_classes->{$symbol_name} };
            $stripped_character_classes{$symbol_name} = $re;
        }
    }
    $hashed_ast->{character_classes} = \%stripped_character_classes;

    return $hashed_ast;
} ## end sub ast_to_hash

sub Marpa::R2::Internal::MetaAST::Parse::start_rule_setup {
    my ($ast) = @_;
    my $start_lhs = $ast->{'start_lhs'} // $ast->{'first_lhs'};
    Marpa::R2::exception('No rules in SLIF grammar')
        if not defined $start_lhs;
    Marpa::R2::Internal::MetaAST::start_rule_create( $ast, $start_lhs );
} ## end sub Marpa::R2::Internal::MetaAST::Parse::start_rule_setup

# This class is for pieces of RHS alternatives, as they are
# being constructed
my $PROTO_ALTERNATIVE = 'Marpa::R2::Internal::MetaAST::Proto_Alternative';

sub Marpa::R2::Internal::MetaAST::Proto_Alternative::combine {
    my ( $class, @hashes ) = @_;
    my $self = bless {}, $class;
    for my $hash_to_add (@hashes) {
        for my $key ( keys %{$hash_to_add} ) {
            ## expect to be caught and rethrown
            die qq{A Marpa rule contained a duplicate key\n},
                qq{  The key was "$key"\n}
                if exists $self->{$key};
            $self->{$key} = $hash_to_add->{$key};
        } ## end for my $key ( keys %{$hash_to_add} )
    } ## end for my $hash_to_add (@hashes)
    return $self;
} ## end sub Marpa::R2::Internal::MetaAST::Proto_Alternative::combine

sub Marpa::R2::Internal::MetaAST::Parse::bless_hash_rule {
    my ( $parse, $hash_rule, $blessing, $naming, $original_lhs ) = @_;
    return if (substr $Marpa::R2::Internal::SUBGRAMMAR, 0, 1) eq 'L';

    $naming //= $original_lhs;
    $hash_rule->{name} = $naming;

    return if not defined $blessing;
    FIND_BLESSING: {
        last FIND_BLESSING if $blessing =~ /\A [\w] /xms;
        return if $blessing eq '::undef';

        # Rule may be half-formed, but assume we have lhs
        if ( $blessing eq '::lhs' ) {
            $blessing = $original_lhs;
            if ( $blessing =~ / [^ [:alnum:]] /xms ) {
                Marpa::R2::exception(
                    qq{"::lhs" blessing only allowed if LHS is whitespace and alphanumerics\n},
                    qq{   LHS was <$original_lhs>\n}
                );
            } ## end if ( $blessing =~ / [^ [:alnum:]] /xms )
            $blessing =~ s/[ ]/_/gxms;
            last FIND_BLESSING;
        } ## end if ( $blessing eq '::lhs' )
        Marpa::R2::exception( qq{Unknown blessing "$blessing"\n} );
    } ## end FIND_BLESSING:
    $hash_rule->{bless} = $blessing;
    return 1;
} ## end sub Marpa::R2::Internal::MetaAST::Parse::bless_hash_rule

sub Marpa::R2::Internal::MetaAST_Nodes::bare_name::name { return $_[0]->[2] }

sub Marpa::R2::Internal::MetaAST_Nodes::reserved_action_name::name {
    my ( $self, $parse ) = @_;
    return $self->[2];
}

sub Marpa::R2::Internal::MetaAST_Nodes::reserved_event_name::name {
    my ( $self, $parse ) = @_;
    my $name = $self->[2];
    $name =~ s/\A : /'/xms;
    return $name;
}

sub Marpa::R2::Internal::MetaAST_Nodes::action_name::name {
    my ( $self, $parse ) = @_;
    return $self->[2]->name($parse);
}

sub Marpa::R2::Internal::MetaAST_Nodes::alternative_name::name {
    my ( $self, $parse ) = @_;
    return $self->[2]->name($parse);
}

sub Marpa::R2::Internal::MetaAST_Nodes::event_name::name {
    my ( $self, $parse ) = @_;
    return $self->[2]->name($parse);
}

sub Marpa::R2::Internal::MetaAST_Nodes::lexer_name::name {
    my ( $self, $parse ) = @_;
    return $self->[2]->name($parse);
}

sub Marpa::R2::Internal::MetaAST_Nodes::array_descriptor::name {
    return $_[0]->[2];
}

sub Marpa::R2::Internal::MetaAST_Nodes::reserved_blessing_name::name {
    return $_[0]->[2];
}

sub Marpa::R2::Internal::MetaAST_Nodes::blessing_name::name {
    my ( $self, $parse ) = @_;
    return $self->[2]->name($parse);
}

sub Marpa::R2::Internal::MetaAST_Nodes::standard_name::name {
    return $_[0]->[2];
}

sub Marpa::R2::Internal::MetaAST_Nodes::Perl_name::name {
    return $_[0]->[2];
}

sub Marpa::R2::Internal::MetaAST_Nodes::lhs::name {
    my ( $values, $parse ) = @_;
    my ( undef, undef, $symbol ) = @{$values};
    return $symbol->name($parse);
}

# After development, delete this
sub Marpa::R2::Internal::MetaAST_Nodes::lhs::evaluate {
    my ( $values, $parse ) = @_;
    return $values->name($parse);
}

sub Marpa::R2::Internal::MetaAST_Nodes::quantifier::evaluate {
    my ($data) = @_;
    return $data->[2];
}

sub Marpa::R2::Internal::MetaAST_Nodes::op_declare::op {
    my ($values) = @_;
    return $values->[2]->op();
}

sub Marpa::R2::Internal::MetaAST_Nodes::op_declare_match::op {
    my ($values) = @_;
    return $values->[2];
}

sub Marpa::R2::Internal::MetaAST_Nodes::op_declare_bnf::op {
    my ($values) = @_;
    return $values->[2];
}

sub Marpa::R2::Internal::MetaAST_Nodes::bracketed_name::name {
    my ($values) = @_;
    my ( undef, undef, $bracketed_name ) = @{$values};

    # normalize whitespace
    $bracketed_name =~ s/\A [<] \s*//xms;
    $bracketed_name =~ s/ \s* [>] \z//xms;
    $bracketed_name =~ s/ \s+ / /gxms;
    return $bracketed_name;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::bracketed_name::name

sub Marpa::R2::Internal::MetaAST_Nodes::single_quoted_name::name {
    my ($values) = @_;
    my ( undef, undef, $single_quoted_name ) = @{$values};

    # normalize whitespace
    $single_quoted_name =~ s/\A ['] \s*//xms;
    $single_quoted_name =~ s/ \s* ['] \z//xms;
    $single_quoted_name =~ s/ \s+ / /gxms;
    return $single_quoted_name;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::single_quoted_name::name

sub Marpa::R2::Internal::MetaAST_Nodes::parenthesized_rhs_primary_list::evaluate
{
    my ( $data, $parse ) = @_;
    my ( undef, undef, @values ) = @{$data};
    my @symbol_lists = map { $_->evaluate($parse); } @values;
    my $flattened_list =
        Marpa::R2::Internal::MetaAST::Symbol_List->combine(@symbol_lists);
    $flattened_list->mask_set(0);
    return $flattened_list;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::parenthesized_rhs_primary_list::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::rhs::evaluate {
    my ( $data, $parse ) = @_;
    my ( $start, $length, @values ) = @{$data};
    my $rhs = eval {
        my @symbol_lists = map { $_->evaluate($parse) } @values;
        my $flattened_list =
            Marpa::R2::Internal::MetaAST::Symbol_List->combine(@symbol_lists);
        bless {
            rhs  => $flattened_list->names($parse),
            mask => $flattened_list->mask()
            },
            $PROTO_ALTERNATIVE;
    };
    if ( not $rhs ) {
        my $eval_error = $EVAL_ERROR;
        chomp $eval_error;
        Marpa::R2::exception(
            qq{$eval_error\n},
            q{  RHS involved was },
            $parse->substring( $start, $length )
        );
    } ## end if ( not $rhs )
    return $rhs;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::rhs::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::rhs_primary::evaluate {
    my ( $data, $parse ) = @_;
    my ( undef, undef, @values ) = @{$data};
    my @symbol_lists = map { $_->evaluate($parse) } @values;
    return Marpa::R2::Internal::MetaAST::Symbol_List->combine(@symbol_lists);
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::rhs_primary::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::rhs_primary_list::evaluate {
    my ( $data, $parse ) = @_;
    my ( undef, undef, @values ) = @{$data};
    my @symbol_lists = map { $_->evaluate($parse) } @values;
    return Marpa::R2::Internal::MetaAST::Symbol_List->combine(@symbol_lists);
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::rhs_primary_list::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::action::evaluate {
    my ( $values, $parse ) = @_;
    my ( undef, undef, $child ) = @{$values};
    return bless { action => $child->name($parse) }, $PROTO_ALTERNATIVE;
}

sub Marpa::R2::Internal::MetaAST_Nodes::blessing::evaluate {
    my ( $values, $parse ) = @_;
    my ( undef, undef, $child ) = @{$values};
    return bless { bless => $child->name($parse) }, $PROTO_ALTERNATIVE;
}

sub Marpa::R2::Internal::MetaAST_Nodes::naming::evaluate {
    my ( $values, $parse ) = @_;
    my ( undef, undef, $child ) = @{$values};
    return bless { name => $child->name($parse) }, $PROTO_ALTERNATIVE;
}

sub Marpa::R2::Internal::MetaAST_Nodes::right_association::evaluate {
    my ($values) = @_;
    return bless { assoc => 'R' }, $PROTO_ALTERNATIVE;
}

sub Marpa::R2::Internal::MetaAST_Nodes::left_association::evaluate {
    my ($values) = @_;
    return bless { assoc => 'L' }, $PROTO_ALTERNATIVE;
}

sub Marpa::R2::Internal::MetaAST_Nodes::group_association::evaluate {
    my ($values) = @_;
    return bless { assoc => 'G' }, $PROTO_ALTERNATIVE;
}

sub Marpa::R2::Internal::MetaAST_Nodes::event_specification::evaluate {
    my ($values) = @_;
    return bless { event => ( $values->[2]->event() ) }, $PROTO_ALTERNATIVE;
}

sub Marpa::R2::Internal::MetaAST_Nodes::event_initialization::event {
    my ($values)         = @_;
    my $event_name       = $values->[2];
    my $event_initializer = $values->[3];
    return [$event_name->name(), $event_initializer->on_or_off()],
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::event_specification::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::proper_specification::evaluate {
    my ($values) = @_;
    my $child = $values->[2];
    return bless { proper => $child->value() }, $PROTO_ALTERNATIVE;
}

sub Marpa::R2::Internal::MetaAST_Nodes::latm_specification::evaluate {
    my ($values) = @_;
    my $child = $values->[2];
    return bless { latm => $child->value() }, $PROTO_ALTERNATIVE;
}

sub Marpa::R2::Internal::MetaAST_Nodes::pause_specification::evaluate {
    my ($values) = @_;
    my $child = $values->[2];
    return bless { pause => $child->value() }, $PROTO_ALTERNATIVE;
}

sub Marpa::R2::Internal::MetaAST_Nodes::priority_specification::evaluate {
    my ($values) = @_;
    my $child = $values->[2];
    return bless { priority => $child->value() }, $PROTO_ALTERNATIVE;
}

sub Marpa::R2::Internal::MetaAST_Nodes::rank_specification::evaluate {
    my ($values) = @_;
    my $child = $values->[2];
    return bless { rank => $child->value() }, $PROTO_ALTERNATIVE;
}

sub Marpa::R2::Internal::MetaAST_Nodes::null_ranking_specification::evaluate {
    my ($values) = @_;
    my $child = $values->[2];
    return bless { null_ranking => $child->value() }, $PROTO_ALTERNATIVE;
}

sub Marpa::R2::Internal::MetaAST_Nodes::null_ranking_constant::value {
    return $_[0]->[2];
}

sub Marpa::R2::Internal::MetaAST_Nodes::before_or_after::value {
    return $_[0]->[2];
}

sub Marpa::R2::Internal::MetaAST_Nodes::event_initializer::on_or_off
{
    # die Data::Dumper::Dumper(\@_);
    my ($values) = @_;
    my $is_activated = $values->[2];
    return 1 if not defined $is_activated;
    return $is_activated->value();
}

sub Marpa::R2::Internal::MetaAST_Nodes::on_or_off::value {
    return $_[0]->[2] eq 'off' ? 0 : 1;
}

sub Marpa::R2::Internal::MetaAST_Nodes::boolean::value {
    return $_[0]->[2];
}

sub Marpa::R2::Internal::MetaAST_Nodes::signed_integer::value {
    return $_[0]->[2];
}

sub Marpa::R2::Internal::MetaAST_Nodes::separator_specification::evaluate {
    my ( $values, $parse ) = @_;
    my $child = $values->[2];
    return bless { separator => $child->name($parse) }, $PROTO_ALTERNATIVE;
}

sub Marpa::R2::Internal::MetaAST_Nodes::adverb_item::evaluate {
    my ( $values, $parse ) = @_;
    my $child = $values->[2]->evaluate($parse);
    return bless $child, $PROTO_ALTERNATIVE;
}

sub Marpa::R2::Internal::MetaAST_Nodes::default_rule::evaluate {
    my ( $values, $parse ) = @_;
    my ( $start, $length, undef, $op_declare, $raw_adverb_list ) = @{$values};
    my $subgrammar = $op_declare->op() eq q{::=} ? 'G1' : $parse->{current_lexer};
    my $adverb_list = $raw_adverb_list->evaluate($parse);

    # A default rule clears the previous default
    my %default_adverbs = ();
    $parse->{default_adverbs}->{$subgrammar} = \%default_adverbs;

    ADVERB: for my $key ( keys %{$adverb_list} ) {
        my $value = $adverb_list->{$key};
        if ( $key eq 'action' and $subgrammar eq 'G1' ) {
            $default_adverbs{$key} = $adverb_list->{$key};
            next ADVERB;
        }
        if ( $key eq 'bless' and $subgrammar eq 'G1' ) {
            $default_adverbs{$key} = $adverb_list->{$key};
            next ADVERB;
        }
        die qq{Adverb "$key" not allowed in $subgrammar default rule\n},
            '  Rule was ', $parse->substring( $start, $length ), "\n";
    } ## end ADVERB: for my $key ( keys %{$adverb_list} )
    ## no critic(Subroutines::ProhibitExplicitReturnUndef)
    return undef;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::default_rule::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::discard_default_statement::evaluate {
    my ( $data, $parse ) = @_;
    my ( $start, $length, $raw_adverb_list ) = @{$data};
    local $Marpa::R2::Internal::SUBGRAMMAR = 'G1';

    my $adverb_list = $raw_adverb_list->evaluate($parse);
    if ( exists $parse->{discard_default_adverbs} ) {
        my $problem_rule = $parse->substring( $start, $length );
        Marpa::R2::exception(
            qq{More than one discard default statement is not allowed\n},
            qq{  This was the rule that caused the problem:\n},
            qq{  $problem_rule\n}
        );
    } ## end if ( exists $parse->{discard_default_adverbs} )
    $parse->{discard_default_adverbs} = {};
    ADVERB: for my $key ( keys %{$adverb_list} ) {
        my $value = $adverb_list->{$key};
        if ( $key eq 'event' and defined $value ) {
            $parse->{discard_default_adverbs}->{$key} = $value;
            next ADVERB;
        }
        Marpa::R2::exception(
            qq{"$key" adverb not allowed as discard default"});
    } ## end ADVERB: for my $key ( keys %{$adverb_list} )
    ## no critic(Subroutines::ProhibitExplicitReturnUndef)
    return undef;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::discard_default_statement::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::lexeme_default_statement::evaluate {
    my ( $data, $parse ) = @_;
    my ( $start, $length, $raw_adverb_list ) = @{$data};
    local $Marpa::R2::Internal::SUBGRAMMAR = 'G1';

    my $adverb_list = $raw_adverb_list->evaluate($parse);
    if ( exists $parse->{lexeme_default_adverbs} ) {
        my $problem_rule = $parse->substring( $start, $length );
        Marpa::R2::exception(
            qq{More than one lexeme default statement is not allowed\n},
            qq{  This was the rule that caused the problem:\n},
            qq{  $problem_rule\n}
        );
    } ## end if ( exists $parse->{lexeme_default_adverbs} )
    $parse->{lexeme_default_adverbs} = {};
    ADVERB: for my $key ( keys %{$adverb_list} ) {
        my $value = $adverb_list->{$key};
        if ( $key eq 'action' ) {
            $parse->{lexeme_default_adverbs}->{$key} = $value;
            next ADVERB;
        }
        if ( $key eq 'bless' ) {
            $parse->{lexeme_default_adverbs}->{$key} = $value;
            next ADVERB;
        }
        if ( $key eq 'latm' ) {
            $parse->{lexeme_default_adverbs}->{$key} = $value;
            next ADVERB;
        }
        Marpa::R2::exception(
            qq{"$key" adverb not allowed as lexeme default"});
    } ## end ADVERB: for my $key ( keys %{$adverb_list} )
    ## no critic(Subroutines::ProhibitExplicitReturnUndef)
    return undef;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::lexeme_default_statement::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::inaccessible_statement::evaluate {
    my ( $data, $parse ) = @_;
    my ( $start, $length, $inaccessible_treatment ) = @{$data};
    local $Marpa::R2::Internal::SUBGRAMMAR = 'G1';

    if ( exists $parse->{defaults}->{if_inaccessible} ) {
        my $problem_rule = $parse->substring( $start, $length );
        Marpa::R2::exception(
            qq{More than one inaccessible default statement is not allowed\n},
            qq{  This was the rule that caused the problem:\n},
            qq{  $problem_rule\n}
        );
    }
    $parse->{defaults}->{if_inaccessible} = $inaccessible_treatment->value();
    return undef;
}

sub Marpa::R2::Internal::MetaAST_Nodes::inaccessible_treatment::value {
    return $_[0]->[2];
}

sub Marpa::R2::Internal::MetaAST_Nodes::priority_rule::evaluate {
    my ( $values, $parse ) = @_;
    my ( $start, $length, $raw_lhs, $op_declare, $raw_priorities ) =
        @{$values};

    my $current_lexer = $parse->{current_lexer};
    my $subgrammar;
    if ( $op_declare->op() eq q{::=} ) {
        if ( $current_lexer ne 'L0' ) {
            my ( $line, $column ) = $parse->{meta_recce}->line_column($start);
            die "G1 rules currently allowed only when L0 is current lexer\n",
                qq{  A prioritized rule was found when "$current_lexer" was the current lexer\n"},
                "  Location was line $line, column $column\n",
                '  Rule was ', $parse->substring( $start, $length ), "\n";
        } ## end if ( $current_lexer ne 'L0' )
        $subgrammar = 'G1';
    } ## end if ( $op_declare->op() eq q{::=} )
    else {
        $subgrammar = $current_lexer;
    }

    my $lhs = $raw_lhs->name($parse);
    $parse->{'first_lhs'} //= $lhs if $subgrammar eq 'G1';
    local $Marpa::R2::Internal::SUBGRAMMAR = $subgrammar;

    my ( undef, undef, @priorities ) = @{$raw_priorities};
    my $priority_count = scalar @priorities;
    my @working_rules  = ();

    $parse->{rules}->{$subgrammar} //= [];
    my $rules = $parse->{rules}->{$subgrammar};

    my $default_adverbs = $parse->{default_adverbs}->{$subgrammar};

    if ( $priority_count <= 1 ) {
        ## If there is only one priority
        my ( undef, undef, @alternatives ) = @{ $priorities[0] };
        for my $alternative (@alternatives) {
            my ($alternative_start, $alternative_end,
                $raw_rhs,           $raw_adverb_list
            ) = @{$alternative};
            my ( $proto_rule, $adverb_list );
            my $eval_ok = eval {
                $proto_rule  = $raw_rhs->evaluate($parse);
                $adverb_list = $raw_adverb_list->evaluate($parse);
                1;
            };
            if ( not $eval_ok ) {
                my $eval_error = $EVAL_ERROR;
                chomp $eval_error;
                Marpa::R2::exception(
                    qq{$eval_error\n},
                    qq{  The problem was in this RHS alternative:\n},
                    q{  },
                    $parse->substring( $alternative_start, $alternative_end ),
                    "\n"
                );
            } ## end if ( not $eval_ok )
            my @rhs_names = @{ $proto_rule->{rhs} };
            my @mask      = @{ $proto_rule->{mask} };
            if ( ( substr $subgrammar, 0, 1 ) eq 'L'
                and grep { !$_ } @mask )
            {
                Marpa::R2::exception(
                    qq{hidden symbols are not allowed in lexical rules (rule's LHS was "$lhs")}
                );
            }
            my %hash_rule =
                ( lhs => $lhs, rhs => \@rhs_names, mask => \@mask );

            my $action;
            my $blessing;
            my $naming;
            my $null_ranking;
            my $rank;
            ADVERB: for my $key ( keys %{$adverb_list} ) {
                my $value = $adverb_list->{$key};
                if ( $key eq 'action' ) {
                    $action = $adverb_list->{$key};
                    next ADVERB;
                }
                if ( $key eq 'assoc' ) {

                    # OK, but ignored
                    next ADVERB;
                }
                if ( $key eq 'bless' ) {
                    $blessing = $adverb_list->{$key};
                    next ADVERB;
                }
                if ( $key eq 'name' ) {
                    $naming = $adverb_list->{$key};
                    next ADVERB;
                }
                if ( $key eq 'null_ranking' ) {
                    $null_ranking = $adverb_list->{$key};
                    next ADVERB;
                }
                if ( $key eq 'rank' ) {
                    $rank = $adverb_list->{$key};
                    next ADVERB;
                }
                my ( $line, $column ) =
                    $parse->{meta_recce}->line_column($start);
                die qq{Adverb "$key" not allowed in an prioritized rule\n},
                    '  Rule was ', $parse->substring( $start, $length ), "\n";
            } ## end ADVERB: for my $key ( keys %{$adverb_list} )

            $action //= $default_adverbs->{action};
            if ( defined $action ) {
                Marpa::R2::exception(
                    qq{actions not allowed in lexical rules (rule's LHS was "$lhs")}
                ) if  ( substr $subgrammar, 0, 1 ) eq 'L';
                $hash_rule{action} = $action;
            } ## end if ( defined $action )

            $rank //= $default_adverbs->{rank};
            if ( defined $rank ) {
                Marpa::R2::exception(
                    qq{ranks not allowed in lexical rules (rule's LHS was "$lhs")}
                ) if  ( substr $subgrammar, 0, 1 ) eq 'L';
                $hash_rule{rank} = $rank;
            } ## end if ( defined $rank )

            $null_ranking //= $default_adverbs->{null_ranking};
            if ( defined $null_ranking ) {
                Marpa::R2::exception(
                    qq{null-ranking allowed in lexical rules (rule's LHS was "$lhs")}
                ) if  ( substr $subgrammar, 0, 1 ) eq 'L';
                $hash_rule{null_ranking} = $null_ranking;
            } ## end if ( defined $rank )

            $blessing //= $default_adverbs->{bless};
            if (defined $blessing
                and
                 ( substr $subgrammar, 0, 1 ) eq 'L'
                )
            {
                Marpa::R2::exception(
                    'bless option not allowed in lexical rules (rules LHS was "',
                    $lhs, '")'
                );
            }

            $parse->bless_hash_rule( \%hash_rule, $blessing, $naming, $lhs );

            push @{$rules}, \%hash_rule;
        } ## end for my $alternative (@alternatives)
        ## no critic(Subroutines::ProhibitExplicitReturnUndef)
        return undef;
    } ## end if ( $priority_count <= 1 )

    for my $priority_ix ( 0 .. $priority_count - 1 ) {
        my $priority = $priority_count - ( $priority_ix + 1 );
        my ( undef, undef, @alternatives ) = @{ $priorities[$priority_ix] };
        for my $alternative (@alternatives) {
            my ($alternative_start, $alternative_end,
                $raw_rhs,           $raw_adverb_list
            ) = @{$alternative};
            my ( $adverb_list, $rhs );
            my $eval_ok = eval {
                $adverb_list = $raw_adverb_list->evaluate($parse);
                $rhs         = $raw_rhs->evaluate($parse);
                1;
            };
            if ( not $eval_ok ) {
                my $eval_error = $EVAL_ERROR;
                chomp $eval_error;
                Marpa::R2::exception(
                    qq{$eval_error\n},
                    qq{  The problem was in this RHS alternative:\n},
                    q{  },
                    $parse->substring( $alternative_start, $alternative_end ),
                    "\n"
                );
            } ## end if ( not $eval_ok )
            push @working_rules, [ $priority, $rhs, $adverb_list ];
        } ## end for my $alternative (@alternatives)
    } ## end for my $priority_ix ( 0 .. $priority_count - 1 )

    # Default mask (all ones) is OK for this rule
    my @arg0_action = ();
    @arg0_action = ( action => '::first' ) if $subgrammar eq 'G1';
    push @{$rules},
        {
        lhs => $lhs,
        rhs => [ $parse->prioritized_symbol( $lhs, 0 ) ],
        @arg0_action,
        description => qq{Internal rule top priority rule for <$lhs>},
        },
        (
        map {
            ;
            {   lhs         => $parse->prioritized_symbol( $lhs,   $_ - 1 ),
                rhs         => [ $parse->prioritized_symbol( $lhs, $_ ) ],
                description => (
                    qq{Internal rule for symbol <$lhs> priority transition from }
                        . ( $_ - 1 )
                        . qq{ to $_}
                ),
                @arg0_action
            }
        } 1 .. $priority_count - 1
        );
    RULE: for my $working_rule (@working_rules) {
        my ( $priority, $rhs, $adverb_list ) = @{$working_rule};
        my @new_rhs = @{ $rhs->{rhs} };
        my @arity   = grep { $new_rhs[$_] eq $lhs } 0 .. $#new_rhs;
        my $rhs_length  = scalar @new_rhs;

        my $current_exp = $parse->prioritized_symbol( $lhs, $priority );
        my @mask = @{ $rhs->{mask} };
        if ( (  substr $subgrammar, 0, 1 ) eq 'L' and grep { !$_ } @mask )
        {
            Marpa::R2::exception(
                'hidden symbols are not allowed in lexical rules (rules LHS was "',
                $lhs, '")'
            );
        }
        my %new_xs_rule = ( lhs => $current_exp );
        $new_xs_rule{mask} = \@mask;

        my $action;
        my $assoc;
        my $blessing;
        my $naming;
        my $rank;
        my $null_ranking;
        ADVERB: for my $key ( keys %{$adverb_list} ) {
            my $value = $adverb_list->{$key};
            if ( $key eq 'action' ) {
                $action = $adverb_list->{$key};
                next ADVERB;
            }
            if ( $key eq 'assoc' ) {
                $assoc = $adverb_list->{$key};
                next ADVERB;
            }
            if ( $key eq 'bless' ) {
                $blessing = $adverb_list->{$key};
                next ADVERB;
            }
            if ( $key eq 'name' ) {
                $naming = $adverb_list->{$key};
                next ADVERB;
            }
            if ( $key eq 'null_ranking' ) {
                $null_ranking = $adverb_list->{$key};
                next ADVERB;
            }
            if ( $key eq 'rank' ) {
                $rank = $adverb_list->{$key};
                next ADVERB;
            }
            my ( $line, $column ) = $parse->{meta_recce}->line_column($start);
            die qq{Adverb "$key" not allowed in a prioritized rule\n},
                '  Rule was ', $parse->substring( $start, $length ), "\n";
        } ## end ADVERB: for my $key ( keys %{$adverb_list} )

        $assoc //= 'L';

        $action //= $default_adverbs->{action};
        if ( defined $action ) {
            Marpa::R2::exception(
                qq{actions not allowed in lexical rules (rule's LHS was "$lhs")}
            ) if  ( substr $subgrammar, 0, 1 ) eq 'L';
            $new_xs_rule{action} = $action;
        } ## end if ( defined $action )

        $null_ranking //= $default_adverbs->{null_ranking};
        if ( defined $null_ranking ) {
            Marpa::R2::exception(
                qq{null-ranking not allowed in lexical rules (rule's LHS was "$lhs")}
            ) if  ( substr $subgrammar, 0, 1 ) eq 'L';
            $new_xs_rule{null_ranking} = $null_ranking;
        } ## end if ( defined $rank )

        $rank //= $default_adverbs->{rank};
        if ( defined $rank ) {
            Marpa::R2::exception(
                qq{ranks not allowed in lexical rules (rule's LHS was "$lhs")}
            ) if  ( substr $subgrammar, 0, 1 ) eq 'L';
            $new_xs_rule{rank} = $rank;
        } ## end if ( defined $rank )

        $blessing //= $default_adverbs->{bless};
        if ( defined $blessing
            and ( substr $subgrammar, 0, 1 ) eq 'L' )
        {
            Marpa::R2::exception(
                'bless option not allowed in lexical rules (rules LHS was "',
                $lhs, '")'
            );
        }

        $parse->bless_hash_rule( \%new_xs_rule, $blessing, $naming, $lhs );

        my $next_priority = $priority + 1;

        # This is probably a mis-feature.  It probably should be
        # $next_priority = $priority if $next_priority >= $priority_count;
        # However, I probably will not change this, because some apps
        # may be relying on this behavior.
        $next_priority = 0 if $next_priority >= $priority_count;

        my $next_exp = $parse->prioritized_symbol( $lhs, $next_priority);

        if ( not scalar @arity ) {
            $new_xs_rule{rhs} = \@new_rhs;
            push @{$rules}, \%new_xs_rule;
            next RULE;
        }

        if ( scalar @arity == 1 ) {
            die 'Unnecessary unit rule in priority rule' if $rhs_length == 1;
            $new_rhs[ $arity[0] ] = $current_exp;
        }
        DO_ASSOCIATION: {
            if ( $assoc eq 'L' ) {
                $new_rhs[ $arity[0] ] = $current_exp;
                for my $rhs_ix ( @arity[ 1 .. $#arity ] ) {
                    $new_rhs[$rhs_ix] = $next_exp;
                }
                last DO_ASSOCIATION;
            } ## end if ( $assoc eq 'L' )
            if ( $assoc eq 'R' ) {
                $new_rhs[ $arity[-1] ] = $current_exp;
                for my $rhs_ix ( @arity[ 0 .. $#arity - 1 ] ) {
                    $new_rhs[$rhs_ix] = $next_exp;
                }
                last DO_ASSOCIATION;
            } ## end if ( $assoc eq 'R' )
            if ( $assoc eq 'G' ) {
                for my $rhs_ix ( @arity[ 0 .. $#arity ] ) {
                    $new_rhs[$rhs_ix] = $parse->prioritized_symbol( $lhs, 0 );
                }
                last DO_ASSOCIATION;
            } ## end if ( $assoc eq 'G' )
            die qq{Unknown association type: "$assoc"};
        } ## end DO_ASSOCIATION:

        $new_xs_rule{rhs} = \@new_rhs;
        push @{$rules}, \%new_xs_rule;
    } ## end RULE: for my $working_rule (@working_rules)
    ## no critic(Subroutines::ProhibitExplicitReturnUndef)
    return undef;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::priority_rule::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::empty_rule::evaluate {
    my ( $values, $parse ) = @_;
    my ( $start, $length, $raw_lhs, $op_declare, $raw_adverb_list ) =
        @{$values};

    my $current_lexer = $parse->{current_lexer};
    my $subgrammar;
    if ( $op_declare->op() eq q{::=} ) {
        if ( $current_lexer ne 'L0' ) {
            my ( $line, $column ) = $parse->{meta_recce}->line_column($start);
            die "G1 rules currently allowed only when L0 is current lexer\n",
                qq{  An empty rule was found when "$current_lexer" was the current lexer\n"},
                "  Location was line $line, column $column\n",
                '  Rule was ', $parse->substring( $start, $length ), "\n";
        } ## end if ( $current_lexer ne 'L0' )
        $subgrammar = 'G1';
    } ## end if ( $op_declare->op() eq q{::=} )
    else {
        $subgrammar = $current_lexer;
    }

    my $lhs = $raw_lhs->name($parse);
    $parse->{'first_lhs'} //= $lhs if $subgrammar eq 'G1';
    local $Marpa::R2::Internal::SUBGRAMMAR = $subgrammar;

    my %rule = ( lhs => $lhs,
    description => qq{Empty rule for <$lhs>},
    rhs => [] );
    my $adverb_list = $raw_adverb_list->evaluate($parse);

    my $default_adverbs = $parse->{default_adverbs}->{$subgrammar};

    my $action;
    my $blessing;
    my $naming;
    my $rank;
    my $null_ranking;
    ADVERB: for my $key ( keys %{$adverb_list} ) {
        my $value = $adverb_list->{$key};
        if ( $key eq 'action' ) {
            $action = $adverb_list->{$key};
            next ADVERB;
        }
        if ( $key eq 'bless' ) {
            $blessing = $adverb_list->{$key};
            next ADVERB;
        }
        if ( $key eq 'name' ) {
            $naming = $adverb_list->{$key};
            next ADVERB;
        }
        if ( $key eq 'null_ranking' ) {
            $null_ranking = $adverb_list->{$key};
            next ADVERB;
        }
        if ( $key eq 'rank' ) {
            $rank = $adverb_list->{$key};
            next ADVERB;
        }
        my ( $line, $column ) = $parse->{meta_recce}->line_column($start);
        die qq{Adverb "$key" not allowed in an empty rule\n},
            '  Rule was ', $parse->substring( $start, $length ), "\n";
    } ## end ADVERB: for my $key ( keys %{$adverb_list} )

    $action //= $default_adverbs->{action};
    if ( defined $action ) {
        Marpa::R2::exception(
            qq{actions not allowed in lexical rules (rule's LHS was "$lhs")}
        ) if  ( substr $subgrammar, 0, 1 ) eq 'L';
        $rule{action} = $action;
    } ## end if ( defined $action )

    $null_ranking //= $default_adverbs->{null_ranking};
    if ( defined $null_ranking ) {
        Marpa::R2::exception(
            qq{null-ranking not allowed in lexical rules (rule's LHS was "$lhs")}
        ) if  ( substr $subgrammar, 0, 1 ) eq 'L';
        $rule{null_ranking} = $null_ranking;
    } ## end if ( defined $null_ranking )

    $rank //= $default_adverbs->{rank};
    if ( defined $rank ) {
        Marpa::R2::exception(
            qq{ranks not allowed in lexical rules (rule's LHS was "$lhs")}
        ) if  ( substr $subgrammar, 0, 1 ) eq 'L';
        $rule{rank} = $rank;
    } ## end if ( defined $rank )

    $blessing //= $default_adverbs->{bless};
    if ( defined $blessing
        and ( substr $subgrammar, 0, 1 ) eq 'L' )
    {
        Marpa::R2::exception(
            qq{bless option not allowed in lexical rules (rule's LHS was "$lhs")}
        );
    }
    $parse->bless_hash_rule( \%rule, $blessing, $naming, $lhs );

    # mask not needed
    push @{ $parse->{rules}->{$subgrammar} }, \%rule;

    ## no critic(Subroutines::ProhibitExplicitReturnUndef)
    return undef;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::empty_rule::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::lexeme_rule::evaluate {
    my ( $values, $parse ) = @_;
    my ( $start, $length, $symbol, $unevaluated_adverb_list ) = @{$values};

    my $symbol_name  = $symbol->name();
    my $declarations = $parse->{lexeme_declarations}->{$symbol_name};
    if ( defined $declarations ) {
        my ( $line, $column ) = $parse->{meta_recce}->line_column($start);
        die "Duplicate lexeme rule for <$symbol_name>\n",
            "  Only one lexeme rule is allowed for each symbol\n",
            "  Location was line $line, column $column\n",
            '  Rule was ', $parse->substring( $start, $length ), "\n";
    } ## end if ( defined $declarations )

    my $adverb_list = $unevaluated_adverb_list->evaluate();
    my %declarations;
    ADVERB: for my $key ( keys %{$adverb_list} ) {
        my $raw_value = $adverb_list->{$key};
        if ( $key eq 'priority' ) {
            $declarations{$key} = $raw_value + 0;
            next ADVERB;
        }
        if ( $key eq 'pause' ) {
            if ( $raw_value eq 'before' ) {
                $declarations{$key} = -1;
                next ADVERB;
            }
            if ( $raw_value eq 'after' ) {
                $declarations{$key} = 1;
                next ADVERB;
            }
            my ( $line, $column ) = $parse->{meta_recce}->line_column($start);
            die qq{Bad value for "pause" adverb: "$raw_value"},
                "  Location was line $line, column $column\n",
                '  Rule was ', $parse->substring( $start, $length ), "\n";
        } ## end if ( $key eq 'pause' )
        if ( $key eq 'event' ) {
            $declarations{$key} = $raw_value;
            next ADVERB;
        }
        if ( $key eq 'latm' ) {
            $declarations{$key} = $raw_value;
            next ADVERB;
        }
        my ( $line, $column ) = $parse->{meta_recce}->line_column($start);
        die qq{"$key" adverb not allowed in lexeme rule"\n},
            "  Location was line $line, column $column\n",
            '  Rule was ', $parse->substring( $start, $length ), "\n";
    } ## end ADVERB: for my $key ( keys %{$adverb_list} )
    if ( exists $declarations{'event'} and not exists $declarations{'pause'} )
    {
        my ( $line, $column ) = $parse->{meta_recce}->line_column($start);
        die
            qq{"event" adverb not allowed without "pause" adverb in lexeme rule"\n},
            "  Location was line $line, column $column\n",
            '  Rule was ', $parse->substring( $start, $length ), "\n";
    } ## end if ( exists $declarations{'event'} and not exists $declarations...)
    $parse->{lexeme_declarations}->{$symbol_name} = \%declarations;
    ## no critic(Subroutines::ProhibitExplicitReturnUndef)
    return undef;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::lexeme_rule::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::statements::evaluate {
    my ( $data, $parse ) = @_;
    my ( undef, undef, @statement_list ) = @{$data};
    map { $_->evaluate($parse) } @statement_list;
    return undef;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::statements::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::statement::evaluate {
    my ( $data, $parse ) = @_;
    my ( undef, undef, $child ) = @{$data};
    $child->evaluate($parse);
    ## no critic(Subroutines::ProhibitExplicitReturnUndef)
    return undef;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::statement::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::null_statement::evaluate {
    return undef;
}

sub Marpa::R2::Internal::MetaAST_Nodes::statement_group::evaluate {
    my ( $data, $parse ) = @_;
    my ( undef, undef, $statements ) = @{$data};
    $statements->evaluate($parse);
    ## no critic(Subroutines::ProhibitExplicitReturnUndef)
    return undef;
}

sub Marpa::R2::Internal::MetaAST::start_rule_create {
    my ( $parse, $symbol_name ) = @_;
    my $start_lhs = '[:start]';
    $parse->{'default_g1_start_action'} =
        $parse->{'default_adverbs'}->{'G1'}->{'action'};
    $parse->{'symbols'}->{'G1'}->{$start_lhs} = {
        display_form => ':start',
        description  => 'Internal G1 start symbol'
    };
    push @{ $parse->{rules}->{G1} },
        {
        lhs    => $start_lhs,
        rhs    => [$symbol_name],
        action => '::first'
        };
} ## end sub Marpa::R2::Internal::MetaAST::start_rule_create

sub Marpa::R2::Internal::MetaAST_Nodes::start_rule::evaluate {
    my ( $values, $parse ) = @_;
    my ( $start, $length, $symbol ) = @{$values};
    if ( defined $parse->{'start_lhs'} ) {
        my ( $line, $column ) = $parse->{meta_recce}->line_column($start);
        die qq{There are two start rules\n},
            qq{  That is not allowed\n},
            '  The second start rule is ',
            $parse->substring( $start, $length ),
            "\n",
            "  Problem occurred at line $line, column $column\n";
    } ## end if ( defined $parse->{'start_lhs'} )
    $parse->{'start_lhs'} = $symbol->name($parse);
    ## no critic(Subroutines::ProhibitExplicitReturnUndef)
    return undef;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::start_rule::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::discard_rule::evaluate {
    my ( $values, $parse ) = @_;
    my ( $start, $length, $symbol, $raw_adverb_list ) = @{$values};

    my $lexer_name = $parse->{current_lexer};
    local $Marpa::R2::Internal::SUBGRAMMAR = $lexer_name;
    my $discard_lhs = '[:discard]';
    $parse->symbol_names_set(
        $discard_lhs,
        'L',
        {   display_form => ':discard',
            description  => qq{Internal LHS for lexer "$lexer_name" discard}
        }
    );
    my $rhs         = $symbol->names($parse);
    my $rhs_as_event         = $symbol->event_name($parse);
    my $adverb_list = $raw_adverb_list->evaluate($parse);
    my $event;
    ADVERB: for my $key ( keys %{$adverb_list} ) {
        my $value = $adverb_list->{$key};
        if ( $key eq 'event' ) {
            $event = $value;
            next ADVERB;
        }
        Marpa::R2::exception(
            qq{"$key" adverb not allowed as discard default"});
    } ## end ADVERB: for my $key ( keys %{$adverb_list} )
    my %rule_hash = (
        description => (
            "Discard rule for " . join q{ },
            map { '<' . $_ . '>' } @{$rhs}
        ),
        lhs => $discard_lhs,
        rhs => $rhs,
        symbol_as_event => $rhs_as_event
    );
    $rule_hash{event} = $event if defined $event;
    push @{ $parse->{rules}->{$lexer_name} }, \%rule_hash;
    ## no critic(Subroutines::ProhibitExplicitReturnUndef)
    return undef;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::discard_rule::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::quantified_rule::evaluate {
    my ( $values, $parse ) = @_;
    my ( $start, $length, $lhs, $op_declare, $rhs, $quantifier,
        $proto_adverb_list )
        = @{$values};

    my $subgrammar;
    my $current_lexer = $parse->{current_lexer};
    if ( $op_declare->op() eq q{::=} ) {
        if ( $current_lexer ne 'L0' ) {
            my ( $line, $column ) = $parse->{meta_recce}->line_column($start);
            die "G1 rules currently allowed only when L0 is current lexer\n",
                qq{  A quantified rule was found when "$current_lexer" was the current lexer\n"},
                "  Location was line $line, column $column\n",
                '  Rule was ', $parse->substring( $start, $length ), "\n";
        } ## end if ( $current_lexer ne 'L0' )
        $subgrammar = 'G1';
    } ## end if ( $op_declare->op() eq q{::=} )
    else {
        $subgrammar = $current_lexer;
    }

    my $lhs_name = $lhs->name($parse);
    $parse->{'first_lhs'} //= $lhs_name if $subgrammar eq 'G1';
    local $Marpa::R2::Internal::SUBGRAMMAR = $subgrammar;

    my $adverb_list     = $proto_adverb_list->evaluate($parse);
    my $default_adverbs = $parse->{default_adverbs}->{$subgrammar};

    # Some properties of the sequence rule will not be altered
    # no matter how complicated this gets
    my %sequence_rule = (
        rhs => [ $rhs->name($parse) ],
        min => ( $quantifier->evaluate($parse) eq q{+} ? 1 : 0 )
    );

    my @rules = ( \%sequence_rule );

    my $action;
    my $blessing;
    my $naming;
    my $separator;
    my $proper;
    my $rank;
    my $null_ranking;
    ADVERB: for my $key ( keys %{$adverb_list} ) {
        my $value = $adverb_list->{$key};
        if ( $key eq 'action' ) {
            $action = $adverb_list->{$key};
            next ADVERB;
        }
        if ( $key eq 'bless' ) {
            $blessing = $adverb_list->{$key};
            next ADVERB;
        }
        if ( $key eq 'name' ) {
            $naming = $adverb_list->{$key};
            next ADVERB;
        }
        if ( $key eq 'proper' ) {
            $proper = $adverb_list->{$key};
            next ADVERB;
        }
        if ( $key eq 'rank' ) {
            $rank = $adverb_list->{$key};
            next ADVERB;
        }
        if ( $key eq 'null_ranking' ) {
            $null_ranking = $adverb_list->{$key};
            next ADVERB;
        }
        if ( $key eq 'separator' ) {
            $separator = $adverb_list->{$key};
            next ADVERB;
        }
        my ( $line, $column ) = $parse->{meta_recce}->line_column($start);
        die qq{Adverb "$key" not allowed in quantified rule\n},
            '  Rule was ', $parse->substring( $start, $length ), "\n";
    } ## end ADVERB: for my $key ( keys %{$adverb_list} )

    # mask not needed
    $sequence_rule{lhs} = $lhs_name;

    $sequence_rule{separator} = $separator
        if defined $separator;
    $sequence_rule{proper} = $proper if defined $proper;

    $action //= $default_adverbs->{action};
    if ( defined $action ) {
        Marpa::R2::exception(
            qq{actions not allowed in lexical rules (rule's LHS was "$lhs")}
        ) if  ( substr $subgrammar, 0, 1 ) eq 'L';
        $sequence_rule{action} = $action;
    } ## end if ( defined $action )

    $null_ranking //= $default_adverbs->{null_ranking};
    if ( defined $null_ranking ) {
        Marpa::R2::exception(
            qq{null-ranking not allowed in lexical rules (rule's LHS was "$lhs")}
        ) if  ( substr $subgrammar, 0, 1 ) eq 'L';
        $sequence_rule{null_ranking} = $null_ranking;
    } ## end if ( defined $null_ranking )

    $rank //= $default_adverbs->{rank};
    if ( defined $rank ) {
        Marpa::R2::exception(
            qq{ranks not allowed in lexical rules (rule's LHS was "$lhs")}
        ) if  ( substr $subgrammar, 0, 1 ) eq 'L';
        $sequence_rule{rank} = $rank;
    } ## end if ( defined $rank )

    $blessing //= $default_adverbs->{bless};
    if ( defined $blessing and ( substr $subgrammar, 0, 1 ) eq 'L' )
    {
        Marpa::R2::exception(
            qq{bless option not allowed in lexical rules (rule's LHS was "$lhs")}
        );
    }
    $parse->bless_hash_rule( \%sequence_rule, $blessing, $naming, $lhs_name );

    push @{ $parse->{rules}->{$subgrammar} }, @rules;
    ## no critic(Subroutines::ProhibitExplicitReturnUndef)
    return undef;

} ## end sub Marpa::R2::Internal::MetaAST_Nodes::quantified_rule::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::completion_event_declaration::evaluate
{
    my ( $values, $parse ) = @_;
    my ( $start, $length, $raw_event, $raw_symbol_name ) = @{$values};
    my $symbol_name       = $raw_symbol_name->name();
    my $completion_events = $parse->{completion_events} //= {};
    if ( defined $completion_events->{$symbol_name} ) {
        my ( $line, $column ) = $parse->{meta_recce}->line_column($start);
        die qq{Completion event for symbol "$symbol_name" declared twice\n},
            qq{  That is not allowed\n},
            '  Second declaration was ', $parse->substring( $start, $length ),
            "\n",
            "  Problem occurred at line $line, column $column\n";
    } ## end if ( defined $completion_events->{$symbol_name} )
    $completion_events->{$symbol_name} = $raw_event->event();
    ## no critic(Subroutines::ProhibitExplicitReturnUndef)
    return undef;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::completion_event_declaration::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::nulled_event_declaration::evaluate {
    my ( $values, $parse ) = @_;
    my ( $start, $length, $raw_event, $raw_symbol_name ) = @{$values};
    my $symbol_name   = $raw_symbol_name->name();
    my $nulled_events = $parse->{nulled_events} //= {};
    if ( defined $nulled_events->{$symbol_name} ) {
        my ( $line, $column ) = $parse->{meta_recce}->line_column($start);
        die qq{nulled event for symbol "$symbol_name" declared twice\n},
            qq{  That is not allowed\n},
            '  Second declaration was ', $parse->substring( $start, $length ),
            "\n",
            "  Problem occurred at line $line, column $column\n";
    } ## end if ( defined $nulled_events->{$symbol_name} )
    $nulled_events->{$symbol_name} = $raw_event->event();
    ## no critic(Subroutines::ProhibitExplicitReturnUndef)
    return undef;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::nulled_event_declaration::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::prediction_event_declaration::evaluate
{
    my ( $values, $parse ) = @_;
    my ( $start, $length, $raw_event, $raw_symbol_name ) = @{$values};
    my $symbol_name       = $raw_symbol_name->name();
    my $prediction_events = $parse->{prediction_events} //= {};
    if ( defined $prediction_events->{$symbol_name} ) {
        my ( $line, $column ) = $parse->{meta_recce}->line_column($start);
        die qq{prediction event for symbol "$symbol_name" declared twice\n},
            qq{  That is not allowed\n},
            '  Second declaration was ', $parse->substring( $start, $length ),
            "\n",
            "  Problem occurred at line $line, column $column\n";
    } ## end if ( defined $prediction_events->{$symbol_name} )
    $prediction_events->{$symbol_name} = $raw_event->event();
    ## no critic(Subroutines::ProhibitExplicitReturnUndef)
    return undef;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::prediction_event_declaration::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::current_lexer_statement::evaluate
{
    my ( $values, $parse ) = @_;
    my ( $start, $length, $lexer_name_object ) = @{$values};
    my $raw_lexer_name        = $lexer_name_object->name();
    if ( $raw_lexer_name eq 'L0' ) {
      $parse->{current_lexer} = $raw_lexer_name;
      ## no critic(Subroutines::ProhibitExplicitReturnUndef)
      return undef;
    }
    if ( $raw_lexer_name =~ m/\A [[:upper:]] [[:digit:]]+ \z/xms) {
        my ( $line, $column ) = $parse->{meta_recce}->line_column($start);
        die qq{Attempt to name a new lexer "$raw_lexer_name"\n},
            qq{  Lexer names of the form [A-Z][0-9]+ are reserved\n},
            qq{  Please choose another name\n},
            "  Problem occurred at line $line, column $column\n";
    } ## end if ( defined $prediction_events->{$symbol_name} )
    my $lexer_name .= 'L-' . $raw_lexer_name;
    $parse->{current_lexer} = $lexer_name;
    ## no critic(Subroutines::ProhibitExplicitReturnUndef)
    return undef;
}

sub Marpa::R2::Internal::MetaAST_Nodes::alternatives::evaluate {
    my ( $values, $parse ) = @_;
    return bless [ map { $_->evaluate( $_, $parse ) } @{$values} ],
        ref $values;
}

sub Marpa::R2::Internal::MetaAST_Nodes::alternative::evaluate {
    my ( $values, $parse ) = @_;
    my ( $start, $length, $rhs, $adverbs ) = @{$values};
    my $alternative = eval {
        Marpa::R2::Internal::MetaAST::Proto_Alternative->combine(
            map { $_->evaluate($parse) } $rhs, $adverbs );
    };
    if ( not $alternative ) {
        Marpa::R2::exception(
            $EVAL_ERROR, "\n",
            q{  Alternative involved was },
            $parse->substring( $start, $length )
        );
    } ## end if ( not $alternative )
    return $alternative;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::alternative::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::single_symbol::names {
    my ( $values, $parse ) = @_;
    my ( undef, undef, $symbol ) = @{$values};
    return $symbol->names($parse);
}

sub Marpa::R2::Internal::MetaAST_Nodes::single_symbol::name {
    my ( $values, $parse ) = @_;
    my ( undef, undef, $symbol ) = @{$values};
    return $symbol->name($parse);
}

sub Marpa::R2::Internal::MetaAST_Nodes::single_symbol::event_name {
    my ( $values, $parse ) = @_;
    my ( undef, undef, $symbol ) = @{$values};
    return $symbol->event_name($parse);
}

sub Marpa::R2::Internal::MetaAST_Nodes::single_symbol::literal {
    my ( $values, $parse ) = @_;
    my ( $start, $length ) = @{$values};
    return $parse->substring($start, $length);
}

sub Marpa::R2::Internal::MetaAST_Nodes::single_symbol::evaluate {
    my ( $values, $parse ) = @_;
    my ( undef, undef, $symbol ) = @{$values};
    return Marpa::R2::Internal::MetaAST::Symbol_List->new(
        $symbol->name($parse) );
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::single_symbol::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::Symbol::evaluate {
    my ( $values, $parse ) = @_;
    my ( undef, undef, $symbol ) = @{$values};
    return $symbol->evaluate($parse);
}

sub Marpa::R2::Internal::MetaAST_Nodes::symbol::name {
    my ( $self, $parse ) = @_;
    return $self->[2]->name($parse);
}

sub Marpa::R2::Internal::MetaAST_Nodes::symbol::event_name {
    my ( $self, $parse ) = @_;
    return $self->[2]->name($parse);
}

sub Marpa::R2::Internal::MetaAST_Nodes::symbol::names {
    my ( $self, $parse ) = @_;
    return $self->[2]->names($parse);
}

sub Marpa::R2::Internal::MetaAST_Nodes::symbol_name::evaluate {
    my ($self) = @_;
    return $self->[2];
}

sub Marpa::R2::Internal::MetaAST_Nodes::symbol_name::name {
    my ( $self, $parse ) = @_;
    return $self->evaluate($parse)->name($parse);
}

sub Marpa::R2::Internal::MetaAST_Nodes::symbol_name::names {
    my ( $self, $parse ) = @_;
    return [ $self->name($parse) ];
}

sub Marpa::R2::Internal::MetaAST_Nodes::adverb_list::evaluate {
    my ( $data, $parse ) = @_;
    my ( undef, undef, $adverb_list_items ) = @{$data};
    return undef if not defined $adverb_list_items;
    return $adverb_list_items->evaluate($parse);
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::adverb_list::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::null_adverb::evaluate {
    return {};
}

sub Marpa::R2::Internal::MetaAST_Nodes::adverb_list_items::evaluate {
    my ( $data, $parse ) = @_;
    my ( undef, undef, @raw_items ) = @{$data};
    my (@adverb_items) = map { $_->evaluate($parse) } @raw_items;
    return Marpa::R2::Internal::MetaAST::Proto_Alternative->combine(
        @adverb_items);
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::adverb_list::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::character_class::event_name {
    my ( $data,  $parse )  = @_;
    my ( $start, $length ) = @{$data};
    return $parse->substring( $start, $length );
}

sub Marpa::R2::Internal::MetaAST_Nodes::character_class::names {
    my ( $self, $parse ) = @_;
    return [ $self->name($parse) ];
}

sub Marpa::R2::Internal::MetaAST_Nodes::character_class::name {
    my ( $self, $parse ) = @_;
    return $self->evaluate($parse)->name($parse);
}

sub Marpa::R2::Internal::MetaAST_Nodes::character_class::evaluate {
    my ( $values, $parse ) = @_;
    my $character_class = $values->[2];
    my $subgrammar = $Marpa::R2::Internal::SUBGRAMMAR;
    if  (( substr $subgrammar, 0, 1 ) eq 'L') {
        return Marpa::R2::Internal::MetaAST::Symbol_List->char_class_to_symbol(
            $parse, $character_class );
    }
    # If here, in G1
    # Character classes and strings always go into L0, for now
    my $lexer_symbol = do {
        local $Marpa::R2::Internal::SUBGRAMMAR = 'L0';
        Marpa::R2::Internal::MetaAST::Symbol_List->char_class_to_symbol(
            $parse, $character_class );
    };
    my $lexical_lhs       = $parse->internal_lexeme($character_class);
    my $lexical_rhs       = $lexer_symbol->names($parse);
    my %lexical_rule      = (
        lhs  => $lexical_lhs,
        rhs  => $lexical_rhs,
        mask => [1],
    );
    push @{ $parse->{rules}->{L0} }, \%lexical_rule;
    my $g1_symbol =
        Marpa::R2::Internal::MetaAST::Symbol_List->new($lexical_lhs);
    return $g1_symbol;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::character_class::evaluate

sub Marpa::R2::Internal::MetaAST_Nodes::single_quoted_string::evaluate {
    my ( $values, $parse ) = @_;
    my ( undef, undef, $string ) = @{$values};
    my @symbols = ();

    my $end_of_string = rindex $string, q{'};
      my $unmodified_string = substr $string, 0, $end_of_string+1;
      my $raw_flags = substr $string, $end_of_string+1;
    my $flags = Marpa::R2::Internal::MetaAST::flag_string_to_flags($raw_flags);
    my $subgrammar = $Marpa::R2::Internal::SUBGRAMMAR;

    # If we are currently in a lexical grammar, the strings go there
    # If we are currently in G1, the strings always go into L0
    my $lexical_grammar = $subgrammar eq 'G1' ? 'L0' : $subgrammar;

    for my $char_class (
        map { '[' . ( quotemeta $_ ) . ']' . $flags } split //xms,
        substr $unmodified_string,
        1, -1
        )
    {
        local $Marpa::R2::Internal::SUBGRAMMAR = $lexical_grammar;
        my $symbol =
            Marpa::R2::Internal::MetaAST::Symbol_List->char_class_to_symbol(
            $parse, $char_class );
        push @symbols, $symbol;
    } ## end for my $char_class ( map { '[' . ( quotemeta $_ ) . ']'...})
    my $list = Marpa::R2::Internal::MetaAST::Symbol_List->combine(@symbols);
    return $list if $Marpa::R2::Internal::SUBGRAMMAR ne 'G1';
    my $lexical_lhs       = $parse->internal_lexeme($string);
    my $lexical_rhs       = $list->names($parse);
    my %lexical_rule      = (
        lhs  => $lexical_lhs,
        rhs  => $lexical_rhs,
        description => "Internal rule for single-quoted string $string",
        mask => [ map { ; 1 } @{$lexical_rhs} ],
    );
    push @{ $parse->{rules}->{$lexical_grammar} }, \%lexical_rule;
    my $g1_symbol =
        Marpa::R2::Internal::MetaAST::Symbol_List->new($lexical_lhs);
    return $g1_symbol;
} ## end sub Marpa::R2::Internal::MetaAST_Nodes::single_quoted_string::evaluate

package Marpa::R2::Internal::MetaAST::Symbol_List;

use English qw( -no_match_vars );

sub new {
    my ( $class, $name ) = @_;
    return bless { names => [ q{} . $name ], mask => [1] }, $class;
}

sub combine {
    my ( $class, @lists ) = @_;
    my $self = {};
    $self->{names} = [ map { @{ $_->names() } } @lists ];
    $self->{mask}  = [ map { @{ $_->mask() } } @lists ];
    return bless $self, $class;
} ## end sub combine

sub Marpa::R2::Internal::MetaAST::char_class_to_re {
    my ($cc_components) = @_;
    die if ref $cc_components ne 'ARRAY';
    my ( $char_class, $flags ) = @{$cc_components};
    $flags = $flags ? '(' . q{?} . $flags . ')' : q{};
    my $regex;
    my $error;
    if ( not defined eval { $regex = qr/$flags$char_class/xms; 1; } ) {
        $error = qq{Problem in evaluating character class: "$char_class"\n};
        $error .= qq{  Flags were "$flags"\n} if $flags;
        $error .= $EVAL_ERROR;
    }
    return $regex, $error;
}

sub Marpa::R2::Internal::MetaAST::flag_string_to_flags {
    my ($raw_flag_string) = @_;
    return q{} if not $raw_flag_string;
    my @raw_flags = split m/:/xms, $raw_flag_string;
    my %flags = ();
    RAW_FLAG: for my $raw_flag (@raw_flags) {
        next RAW_FLAG if not $raw_flag;
        if ( $raw_flag eq 'i' ) {
            $flags{'i'} = 1;
            next RAW_FLAG;
        }
        if ( $raw_flag eq 'ic' ) {
            $flags{'i'} = 1;
            next RAW_FLAG;
        }
        Carp::croak(
            qq{Bad flag for character class\n},
            qq{  Flag string was $raw_flag_string\n},
            qq{  Bad flag was $raw_flag\n}
        );
    } ## end RAW_FLAG: for my $raw_flag (@raw_flags)
    my $cooked_flags = join q{}, sort keys %flags;
    return $cooked_flags;
} ## end sub flag_string_to_flags

# Return the character class symbol name,
# after ensuring everything is set up properly
sub char_class_to_symbol {
    my ( $class, $parse, $char_class ) = @_;

    my $end_of_char_class = rindex $char_class, q{]};
      my $unmodified_char_class = substr $char_class, 0, $end_of_char_class+1;
      my $raw_flags = substr $char_class, $end_of_char_class+1;
    my $flags = Marpa::R2::Internal::MetaAST::flag_string_to_flags($raw_flags);
    my $subgrammar = $Marpa::R2::Internal::SUBGRAMMAR;

    # character class symbol name always start with TWO left square brackets
    my $symbol_name = '[' . $unmodified_char_class . $flags . ']';
    $parse->{character_classes} //= {};
    my $cc_hash = $parse->{character_classes};
    my ( undef, $symbol ) = $cc_hash->{$symbol_name};
    if ( not defined $symbol ) {

        my $cc_components = [$unmodified_char_class, $flags];

        # Fast fail on badly formed char_class -- we re-evaluate the regex just in time
        # before we register characters.
        my ( $regex, $eval_error ) =
            Marpa::R2::Internal::MetaAST::char_class_to_re($cc_components);
        Carp::croak( 'Bad Character class: ',
            $char_class, "\n", 'Perl said ', $eval_error )
            if not $regex;

        $symbol =
            Marpa::R2::Internal::MetaAST::Symbol_List->new($symbol_name);
        $cc_hash->{$symbol_name} = [ $cc_components, $symbol ];
        $parse->symbol_names_set(
            $symbol_name,
            $subgrammar,
            {   dsl_form     => $char_class,
                display_form => $char_class,
                description  => "Character class: $char_class"
            }
        );
    } ## end if ( not defined $symbol )
    return $symbol;
} ## end sub char_class_to_symbol

sub Marpa::R2::Internal::MetaAST::Parse::symbol_names_set {
    my ( $parse, $symbol, $subgrammar, $args ) = @_;
    my $symbol_type = $subgrammar eq 'G1' ? 'G1' : 'L';
    for my $arg_type (keys %{$args}) {
        my $value = $args->{$arg_type};
        $parse->{symbols}->{$symbol_type}->{$symbol}->{$arg_type} = $value;
    }
}

# Return the priotized symbol name,
# after ensuring everything is set up properly
sub Marpa::R2::Internal::MetaAST::Parse::prioritized_symbol {
    my ( $parse, $base_symbol, $priority ) = @_;

    # character class symbol name always start with TWO left square brackets
    my $symbol_name = $base_symbol . '[' . $priority . ']';
    my $symbol_data =
        $parse->{symbols}->{$Marpa::R2::Internal::SUBGRAMMAR eq 'G1' ? 'G1' : 'L'}->{$symbol_name};
    return $symbol_name if defined $symbol_data;
    my $display_form =
        ( $base_symbol =~ m/\s/xms ) ? "<$base_symbol>" : $base_symbol;
    $parse->symbol_names_set(
        $symbol_name,
        $Marpa::R2::Internal::SUBGRAMMAR,
        {   legacy_name  => $base_symbol,
            dsl_form     => $base_symbol,
            display_form => $display_form,
            description  => "<$base_symbol> at priority $priority"
        }
    );
    return $symbol_name;
} ## end sub Marpa::R2::Internal::MetaAST::Parse::prioritized_symbol

# Return the prioritized symbol name,
# after ensuring everything is set up properly
sub Marpa::R2::Internal::MetaAST::Parse::internal_lexeme {
    my ( $parse, $dsl_form, @grammars ) = @_;

    # character class symbol name always start with TWO left square brackets
    my $lexical_lhs_index = $parse->{lexical_lhs_index}++;
    my $lexical_symbol    = "[Lex-$lexical_lhs_index]";
    my %names             = (
        dsl_form     => $dsl_form,
        display_form => $dsl_form,
        description  => qq{Internal lexical symbol for "$dsl_form"}
    );
    $parse->symbol_names_set( $lexical_symbol, $_, \%names ) for qw(G1 L);
    return $lexical_symbol;
} ## end sub Marpa::R2::Internal::MetaAST::Parse::internal_lexeme

sub name {
    my ($self) = @_;
    my $names = $self->{names};
    Marpa::R2::exception( 'list->name() on symbol list of length ',
        scalar @{$names} )
        if scalar @{$names} != 1;
    return $self->{names}->[0];
} ## end sub name
sub names { return shift->{names} }
sub mask  { return shift->{mask} }

sub mask_set {
    my ( $self, $mask ) = @_;
    return $self->{mask} = [ map {$mask} @{ $self->{mask} } ];
}

1;

# vim: expandtab shiftwidth=4: