File: Grammar.pm

package info (click to toggle)
libmarpa-r2-perl 12.000000-1
links: PTS, VCS
area: main
in suites: forky, sid
size: 6,660 kB
sloc: perl: 42,628; ansic: 23,387; sh: 4,363; makefile: 157
file content (1648 lines) | stat: -rw-r--r-- 64,321 bytes
# 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::Grammar;

use 5.010001;

use warnings;

# There's a problem with this perlcritic check
# as of 9 Aug 2010
no warnings qw(recursion qw);

use strict;

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

package Marpa::R2::Internal::Grammar;

use English qw( -no_match_vars );

use Marpa::R2::Thin::Trace;

our %DEFAULT_SYMBOLS_RESERVED;
%DEFAULT_SYMBOLS_RESERVED = map { ($_, 1) } split //xms, '}]>)';

sub Marpa::R2::uncaught_error {
    my ($error) = @_;

    # This would be Carp::confess, but in the testing
    # the stack trace includes the hoped for error
    # message, which causes spurious success reports.
    Carp::croak( "libmarpa reported an error which Marpa::R2 did not catch\n",
        $error );
} ## end sub Marpa::R2::uncaught_error

package Marpa::R2::Internal::Grammar;

sub Marpa::R2::Grammar::new {
    my ( $class, @arg_hashes ) = @_;

    my $grammar = [];
    bless $grammar, $class;

    # set the defaults and the default defaults
    $grammar->[Marpa::R2::Internal::Grammar::TRACE_FILE_HANDLE] = *STDERR;

    $grammar->[Marpa::R2::Internal::Grammar::TRACE_RULES]     = 0;
    $grammar->[Marpa::R2::Internal::Grammar::WARNINGS]        = 1;
    $grammar->[Marpa::R2::Internal::Grammar::INACCESSIBLE_OK] = {};
    $grammar->[Marpa::R2::Internal::Grammar::UNPRODUCTIVE_OK] = {};
    $grammar->[Marpa::R2::Internal::Grammar::INFINITE_ACTION] = 'fatal';

    $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS]            = [];
    $grammar->[Marpa::R2::Internal::Grammar::RULES]              = [];
    $grammar->[Marpa::R2::Internal::Grammar::RULE_ID_BY_TAG]     = {};

    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C] =
        Marpa::R2::Thin::G->new( { if => 1 } );
    $grammar->[Marpa::R2::Internal::Grammar::TRACER] =
        Marpa::R2::Thin::Trace->new($grammar_c);

    $grammar->set(@arg_hashes);

    return $grammar;
} ## end sub Marpa::R2::Grammar::new

sub Marpa::R2::Grammar::tracer {
    return $_[0]->[Marpa::R2::Internal::Grammar::TRACER];
}

sub Marpa::R2::Grammar::thin {
    return $_[0]->[Marpa::R2::Internal::Grammar::C];
}

sub Marpa::R2::Grammar::thin_symbol {
    my ( $grammar, $symbol_name ) = @_;
    return $grammar->[Marpa::R2::Internal::Grammar::TRACER]
        ->symbol_by_name($symbol_name);
}

sub Marpa::R2::Grammar::set {
    my ( $grammar, @arg_hashes ) = @_;

    # set trace_fh even if no tracing, because we may turn it on in this method
    my $trace_fh =
        $grammar->[Marpa::R2::Internal::Grammar::TRACE_FILE_HANDLE];
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];

    for my $args (@arg_hashes) {

        my $ref_type = ref $args;
        if ( not $ref_type ) {
            Carp::croak(
                'Marpa::R2::Grammar expects args as ref to HASH; arg was non-reference'
            );
        }
        if ( $ref_type ne 'HASH' ) {
            Carp::croak(
                "Marpa::R2::Grammar expects args as ref to HASH, got ref to $ref_type instead"
            );
        }

        state $grammar_options = {
            map { ( $_, 1 ) }
                qw{ _internal_
                action_object
                actions
                bless_package
                infinite_action
                default_action
                default_empty_action
                default_rank
                inaccessible_ok
                rules
                source
                start
                symbols
                terminals
                trace_file_handle
                unproductive_ok
                warnings
                }
        };

        if (my @bad_options =
            grep { not exists $grammar_options->{$_} }
            keys %{$args}
            )
        {
            Carp::croak( 'Unknown option(s) for Marpa::R2::Grammar: ',
                join q{ }, @bad_options );
        } ## end if ( my @bad_options = grep { not exists $grammar_options...})

        # First pass options: These affect processing of other
        # options and are expected to take force for the other
        # options, even if specified afterwards

        if ( defined( my $value = $args->{'_internal_'} ) ) {
            $grammar->[Marpa::R2::Internal::Grammar::INTERNAL] =  $value;
        }

        if ( defined( my $value = $args->{'trace_file_handle'} ) ) {
            $trace_fh =
                $grammar->[Marpa::R2::Internal::Grammar::TRACE_FILE_HANDLE] =
                $value;
        }

        if ( defined( my $value = $args->{'default_rank'} ) ) {
            Marpa::R2::exception(
                'default_rank option not allowed after grammar is precomputed'
            ) if $grammar_c->is_precomputed();
            $grammar_c->default_rank_set($value);
        } ## end if ( defined( my $value = $args->{'default_rank'} ) )


        # Second pass options

        if ( defined( my $value = $args->{'symbols'} ) ) {
            Marpa::R2::exception(
                'symbols option not allowed after grammar is precomputed')
                if $grammar_c->is_precomputed();
            Marpa::R2::exception('symbols value must be REF to HASH')
                if ref $value ne 'HASH';
            for my $symbol ( sort keys %{$value} ) {
                my $properties = $value->{$symbol};
                assign_user_symbol( $grammar, $symbol, $properties );
            }
        } ## end if ( defined( my $value = $args->{'symbols'} ) )

        if ( defined( my $value = $args->{'terminals'} ) ) {
            Marpa::R2::exception(
                'terminals option not allowed after grammar is precomputed')
                if $grammar_c->is_precomputed();
            Marpa::R2::exception('terminals value must be REF to ARRAY')
                if ref $value ne 'ARRAY';
            for my $symbol ( @{$value} ) {
                assign_user_symbol( $grammar, $symbol, { terminal => 1 } );
            }
        } ## end if ( defined( my $value = $args->{'terminals'} ) )

        if ( defined( my $value = $args->{'start'} ) ) {
            Marpa::R2::exception(
                'start option not allowed after grammar is precomputed')
                if $grammar_c->is_precomputed();
            $grammar->[Marpa::R2::Internal::Grammar::START_NAME] = $value;
        } ## end if ( defined( my $value = $args->{'start'} ) )

        my $stuifzand_source;
        my $deprecated_source;

        if ( defined( my $value = $args->{'source'} ) ) {
            Marpa::R2::exception(
                'source option not allowed after grammar is precomputed')
                if $grammar_c->is_precomputed();
            Marpa::R2::exception(
                q{"source" named argument must be string or ref to SCALAR}
            ) if ref $value ne 'SCALAR';
            $stuifzand_source = $value;
        }

        if ( defined( my $value = $args->{'rules'} ) ) {
            Marpa::R2::exception(
                'rules option not allowed after grammar is precomputed')
                if $grammar_c->is_precomputed();
            DO_RULES: {
                ## These hacks are for previous method of specifying Stuifzand
                ## grammars.  They are now deprecated and undocumented.
                ## Eventually they may be eliminated.
                if (    ref $value eq 'ARRAY'
                    and scalar @{$value} == 1
                    and not ref $value->[0] )
                {
                    $value = $value->[0];
                } ## end if ( ref $value eq 'ARRAY' and scalar @{$value} == 1...)
                if ( not ref $value ) {
                   $deprecated_source = \$value;
                }
                if (defined $deprecated_source and defined $stuifzand_source) {
                    Marpa::R2::exception(
                        qq{Attempt to specify BNF via both 'rules' and 'source' named arguments\n},
                        q{  You must use one or the other},
                        )
                }
                if (defined $deprecated_source) {
                    $stuifzand_source = $deprecated_source;
                    last DO_RULES;
                }
                Marpa::R2::exception(
                    q{"rules" named argument must be string or ref to ARRAY}
                ) if ref $value ne 'ARRAY';
                $grammar->[Marpa::R2::Internal::Grammar::INTERFACE] //=
                    'standard';
                Marpa::R2::exception(
                    qq{Attempt to use the standard interface with a grammar that is already using the BNF interface\n},
                    q{  Mixing the BNF and standard interface is not allowed}
                    )
                    if $grammar->[Marpa::R2::Internal::Grammar::INTERFACE] ne
                        'standard';
                add_user_rules( $grammar, $value );
            } ## end DO_RULES:
        } ## end if ( defined( my $value = $args->{'rules'} ) )

        if ( defined $stuifzand_source ) {
            $grammar->[Marpa::R2::Internal::Grammar::INTERFACE] //=
                'stuifzand';
            Marpa::R2::exception(
                qq{Attempt to use the standard interface with a grammar that is already using the BNF interface\n},
                q{  Mixing the BNF and standard interface is not allowed}
                )
                if $grammar->[Marpa::R2::Internal::Grammar::INTERFACE] ne
                    'stuifzand';
            my $parse_result =
                Marpa::R2::Internal::Stuifzand::parse_rules( 
                $stuifzand_source );
            for my $rule ( @{ $parse_result->{rules} } ) {
                add_user_rule( $grammar, $rule );
            }
        } ## end if ( defined $stuifzand_source )

        if ( exists $args->{'default_empty_action'} ) {
            my $value = $args->{'default_empty_action'};
            $grammar->[Marpa::R2::Internal::Grammar::DEFAULT_EMPTY_ACTION] =
                $value;
        }

        if ( defined( my $value = $args->{'actions'} ) ) {
            $grammar->[Marpa::R2::Internal::Grammar::ACTIONS] = $value;
        }

        if ( defined( my $value = $args->{'bless_package'} ) ) {
            $grammar->[Marpa::R2::Internal::Grammar::BLESS_PACKAGE] = $value;
        }

        if ( defined( my $value = $args->{'action_object'} ) ) {
            $grammar->[Marpa::R2::Internal::Grammar::ACTION_OBJECT] = $value;
        }

        if ( defined( my $value = $args->{'default_action'} ) ) {
            $grammar->[Marpa::R2::Internal::Grammar::DEFAULT_ACTION] = $value;
        }

        if ( defined( my $value = $args->{'infinite_action'} ) ) {
            if ( $value && $grammar_c->is_precomputed() ) {
                say {$trace_fh}
                    '"infinite_action" option is useless after grammar is precomputed'
                    or Marpa::R2::exception("Could not print: $ERRNO");
            }
            state $allowed_values =
                { map { ( $_, 1 ) } qw(warn quiet fatal) };
            Marpa::R2::exception(
                q{infinite_action must be 'warn', 'quiet' or 'fatal'})
                if not exists $allowed_values->{$value};
            $grammar->[Marpa::R2::Internal::Grammar::INFINITE_ACTION] =
                $value;
        } ## end if ( defined( my $value = $args->{'infinite_action'}...))

        if ( defined( my $value = $args->{'warnings'} ) ) {
            if ( $value && $grammar_c->is_precomputed() ) {
                say {$trace_fh}
                    q{"warnings" option is useless after grammar is precomputed}
                    or Marpa::R2::exception("Could not print: $ERRNO");
            }
            $grammar->[Marpa::R2::Internal::Grammar::WARNINGS] = $value;
        } ## end if ( defined( my $value = $args->{'warnings'} ) )

        if ( defined( my $value = $args->{'inaccessible_ok'} ) ) {
            if ( $value && $grammar_c->is_precomputed() ) {
                say {$trace_fh}
                    q{"inaccessible_ok" option is useless after grammar is precomputed}
                    or Marpa::R2::exception("Could not print: $ERRNO");

            } ## end if ( $value && $grammar_c->is_precomputed() )
            GIVEN_REF_VALUE: {
                my $ref_value = ref $value;
                if ( $ref_value eq q{} ) {
                    $value //= {};
                    last GIVEN_REF_VALUE;
                }
                if ( $ref_value eq 'ARRAY' ) {
                    $value = { map { ( $_, 1 ) } @{$value} };
                    last GIVEN_REF_VALUE;
                }
                Marpa::R2::exception(
                    'value of inaccessible_ok option must be boolean or an array ref'
                );
            } ## end GIVEN_REF_VALUE:
            $grammar->[Marpa::R2::Internal::Grammar::INACCESSIBLE_OK] =
                $value;
        } ## end if ( defined( my $value = $args->{'inaccessible_ok'}...))

        if ( defined( my $value = $args->{'unproductive_ok'} ) ) {
            if ( $value && $grammar_c->is_precomputed() ) {
                say {$trace_fh}
                    q{"unproductive_ok" option is useless after grammar is precomputed}
                    or Marpa::R2::exception("Could not print: $ERRNO");
            }
            GIVEN_REF_VALUE: {
                my $ref_value = ref $value;
                if ( $ref_value eq q{} ) {
                    $value //= {};
                    last GIVEN_REF_VALUE;
                }
                if ( $ref_value eq 'ARRAY' ) {
                    $value = { map { ( $_, 1 ) } @{$value} };
                    last GIVEN_REF_VALUE;
                }
                Marpa::R2::exception(
                        'value of unproductive_ok option must be boolean or an array ref'
                );
            } ## end GIVEN_REF_VALUE:
            $grammar->[Marpa::R2::Internal::Grammar::UNPRODUCTIVE_OK] =
                $value;
        } ## end if ( defined( my $value = $args->{'unproductive_ok'}...))

    } ## end for my $args (@arg_hashes)

    return 1;
} ## end sub Marpa::R2::Grammar::set

sub Marpa::R2::Grammar::symbol_reserved_set {
    my ( $grammar, $final_character, $boolean ) = @_;
    if ( length $final_character != 1 ) {
        Marpa::R2::exception( 'symbol_reserved_set(): "',
            $final_character, '" is not a symbol' );
    }
    if ( $final_character eq ']' ) {
        return if $boolean;
        Marpa::R2::exception(
            q{symbol_reserved_set(): Attempt to unreserve ']'; this is not allowed}
        );
    } ## end if ( $final_character eq ']' ) ([)
    if ( not exists $DEFAULT_SYMBOLS_RESERVED{$final_character} ) {
        Marpa::R2::exception(
            qq{symbol_reserved_set(): "$final_character" is not a reservable symbol}
        );
    }
    # Return a value to make perlcritic happy
    return $DEFAULT_SYMBOLS_RESERVED{$final_character} = $boolean ? 1 : 0;
} ## end sub Marpa::R2::Grammar::symbol_reserved_set

sub Marpa::R2::Grammar::precompute {
    my $grammar = shift;

    my $rules     = $grammar->[Marpa::R2::Internal::Grammar::RULES];
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my $trace_fh =
        $grammar->[Marpa::R2::Internal::Grammar::TRACE_FILE_HANDLE];

    my $problems = $grammar->[Marpa::R2::Internal::Grammar::PROBLEMS];
    if ($problems) {
        Marpa::R2::exception(
            Marpa::R2::Grammar::show_problems($grammar),
            "Second attempt to precompute grammar with fatal problems\n",
            'Marpa::R2 cannot proceed'
        );
    } ## end if ($problems)

    return $grammar if $grammar_c->is_precomputed();

    set_start_symbol($grammar);

    # Catch errors in precomputation
    my $precompute_error_code = $Marpa::R2::Error::NONE;
    $grammar_c->throw_set(0);
    my $precompute_result = $grammar_c->precompute();
    $grammar_c->throw_set(1);

    if ( $precompute_result < 0 ) {
        ($precompute_error_code) = $grammar_c->error();
        if ( not defined $precompute_error_code ) {
            Marpa::R2::exception(
                'libmarpa error, but no error code returned');
        }

        # If already precomputed, just return success
        return $grammar
            if $precompute_error_code == $Marpa::R2::Error::PRECOMPUTED;

        # Cycles are not necessarily errors,
        # and get special handling
        $precompute_error_code = $Marpa::R2::Error::NONE
            if $precompute_error_code == $Marpa::R2::Error::GRAMMAR_HAS_CYCLE;

    } ## end if ( $precompute_result < 0 )

    if ( $precompute_error_code != $Marpa::R2::Error::NONE ) {

        # Report the errors, then return failure

        if ( $precompute_error_code == $Marpa::R2::Error::NO_RULES ) {
            Marpa::R2::exception(
                'Attempted to precompute grammar with no rules');
        }
        if ( $precompute_error_code == $Marpa::R2::Error::NULLING_TERMINAL ) {
            my @nulling_terminals = ();
            my $event_count       = $grammar_c->event_count();
            EVENT:
            for ( my $event_ix = 0; $event_ix < $event_count; $event_ix++ ) {
                my ( $event_type, $value ) = $grammar_c->event($event_ix);
                if ( $event_type eq 'MARPA_EVENT_NULLING_TERMINAL' ) {
                    push @nulling_terminals, $grammar->symbol_name($value);
                }
            } ## end EVENT: for ( my $event_ix = 0; $event_ix < $event_count; ...)
            my @nulling_terminal_messages =
                map {qq{Nulling symbol "$_" is also a terminal\n}}
                @nulling_terminals;
            Marpa::R2::exception( @nulling_terminal_messages,
                'A terminal symbol cannot also be a nulling symbol' );
        } ## end if ( $precompute_error_code == ...)
        if ( $precompute_error_code == $Marpa::R2::Error::COUNTED_NULLABLE ) {
            my @counted_nullables = ();
            my $event_count       = $grammar_c->event_count();
            EVENT:
            for ( my $event_ix = 0; $event_ix < $event_count; $event_ix++ ) {
                my ( $event_type, $value ) = $grammar_c->event($event_ix);
                if ( $event_type eq 'MARPA_EVENT_COUNTED_NULLABLE' ) {
                    push @counted_nullables, $grammar->symbol_name($value);
                }
            } ## end EVENT: for ( my $event_ix = 0; $event_ix < $event_count; ...)
            my @counted_nullable_messages = map {
                      q{Nullable symbol "}
                    . $_
                    . qq{" is on RHS of counted rule\n}
            } @counted_nullables;
            Marpa::R2::exception( @counted_nullable_messages,
                'Counted nullables confuse Marpa -- please rewrite the grammar'
            );
        } ## end if ( $precompute_error_code == ...)

        if ( $precompute_error_code == $Marpa::R2::Error::NO_START_SYMBOL ) {
            Marpa::R2::exception('No start symbol');
        }
        if ( $precompute_error_code == $Marpa::R2::Error::START_NOT_LHS ) {
            my $name = $grammar->[Marpa::R2::Internal::Grammar::START_NAME];
            Marpa::R2::exception(
                qq{Start symbol "$name" not on LHS of any rule});
        }
        if ( $precompute_error_code == $Marpa::R2::Error::UNPRODUCTIVE_START )
        {
            my $name = $grammar->[Marpa::R2::Internal::Grammar::START_NAME];
            Marpa::R2::exception(qq{Unproductive start symbol: "$name"});
        }

        Marpa::R2::uncaught_error( scalar $grammar_c->error() );

    } ## end if ( $precompute_error_code != $Marpa::R2::Error::NONE)

    # Shadow all the new rules
    {
        my $highest_rule_id = $grammar_c->highest_rule_id();
        RULE:
        for ( my $rule_id = 0; $rule_id <= $highest_rule_id; $rule_id++ ) {
            next RULE if defined $rules->[$rule_id];

            # The Marpa::R2 logic assumes no "gaps" in the rule numbering,
            # which is currently the case for Libmarpa,
            # but not guaranteed.
            shadow_rule( $grammar, $rule_id );
        } ## end RULE: for ( my $rule_id = 0; $rule_id <= $highest_rule_id; ...)
    }

    my $infinite_action =
        $grammar->[Marpa::R2::Internal::Grammar::INFINITE_ACTION];

    # Above I went through the error events
    # Here I go through the events for situations where there was no
    # hard error returned from libmarpa
    my $loop_rule_count = 0;
    {
        my $event_count = $grammar_c->event_count();
        EVENT:
        for ( my $event_ix = 0; $event_ix < $event_count; $event_ix++ ) {
            my ( $event_type, $value ) = $grammar_c->event($event_ix);
            if ( $event_type ne 'MARPA_EVENT_LOOP_RULES' ) {
                Marpa::R2::exception(
                    qq{Unknown grammar precomputation event; type="$event_type"}
                );
            }
            $loop_rule_count = $value;
        } ## end EVENT: for ( my $event_ix = 0; $event_ix < $event_count; ...)
    }

    if ( $loop_rule_count and $infinite_action ne 'quiet' ) {
        my @loop_rules =
            grep { $grammar_c->rule_is_loop($_) } ( 0 .. $#{$rules} );
        for my $rule_id (@loop_rules) {
            print {$trace_fh}
                'Cycle found involving rule: ',
                $grammar->brief_rule($rule_id), "\n"
                or Marpa::R2::exception("Could not print: $ERRNO");
        } ## end for my $rule_id (@loop_rules)
        Marpa::R2::exception('Cycles in grammar, fatal error')
            if $infinite_action eq 'fatal';
    } ## end if ( $loop_rule_count and $infinite_action ne 'quiet')

    # A bit hackish here: INACCESSIBLE_OK is not a HASH ref iff
    # it is a Boolean TRUE indicating that all inaccessibles are OK.
    # A Boolean FALSE will have been replaced with an empty hash.
    if ($grammar->[Marpa::R2::Internal::Grammar::WARNINGS]
        and ref(
            my $ok = $grammar->[Marpa::R2::Internal::Grammar::INACCESSIBLE_OK]
        ) eq 'HASH'
        )
    {
        SYMBOL:
        for my $symbol (
            @{ Marpa::R2::Grammar::inaccessible_symbols($grammar) } )
        {

            # Inaccessible internal symbols may be created
            # from inaccessible use symbols -- ignore these.
            # This assumes that Marpa's logic
            # is correct and that
            # it is not creating inaccessible symbols from
            # accessible ones.
            next SYMBOL if $symbol =~ /\]/xms;
            next SYMBOL if $ok->{$symbol};
            say {$trace_fh} "Inaccessible symbol: $symbol"
                or Marpa::R2::exception("Could not print: $ERRNO");
        } ## end SYMBOL: for my $symbol ( @{ ...})
    } ## end if ( $grammar->[Marpa::R2::Internal::Grammar::WARNINGS...])

    # A bit hackish here: UNPRODUCTIVE_OK is not a HASH ref iff
    # it is a Boolean TRUE indicating that all inaccessibles are OK.
    # A Boolean FALSE will have been replaced with an empty hash.
    if ($grammar->[Marpa::R2::Internal::Grammar::WARNINGS]
        and ref(
            my $ok = $grammar->[Marpa::R2::Internal::Grammar::UNPRODUCTIVE_OK]
        ) eq 'HASH'
        )
    {
        SYMBOL:
        for my $symbol (
            @{ Marpa::R2::Grammar::unproductive_symbols($grammar) } )
        {

            # Unproductive internal symbols may be created
            # from unproductive use symbols -- ignore these.
            # This assumes that Marpa's logic
            # is correct and that
            # it is not creating unproductive symbols from
            # productive ones.
            next SYMBOL if $symbol =~ /\]/xms;
            next SYMBOL if $ok->{$symbol};
            say {$trace_fh} "Unproductive symbol: $symbol"
                or Marpa::R2::exception("Could not print: $ERRNO");
        } ## end SYMBOL: for my $symbol ( @{ ...})
    } ## end if ( $grammar->[Marpa::R2::Internal::Grammar::WARNINGS...])

    # If we are using scannerless parsing, set that up
    Marpa::R2::exception("Internal error; precompute called for SLIF grammar")
        if $grammar->[Marpa::R2::Internal::Grammar::CHARACTER_CLASSES];

    return $grammar;

} ## end sub Marpa::R2::Grammar::precompute

# A custom precompute for SLIF grammars
sub Marpa::R2::Internal::Grammar::slif_precompute {
    my $grammar = shift;

    my $rules     = $grammar->[Marpa::R2::Internal::Grammar::RULES];
    my $symbols     = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my $trace_fh =
        $grammar->[Marpa::R2::Internal::Grammar::TRACE_FILE_HANDLE];

    my $problems = $grammar->[Marpa::R2::Internal::Grammar::PROBLEMS];
    if ($problems) {
        Marpa::R2::exception(
            Marpa::R2::Grammar::show_problems($grammar),
            "Second attempt to precompute grammar with fatal problems\n",
            'Marpa::R2 cannot proceed'
        );
    } ## end if ($problems)

    return if $grammar_c->is_precomputed();
    if ($grammar_c->force_valued() < 0) {
        Marpa::R2::uncaught_error( scalar $grammar_c->error() );
    }

    set_start_symbol($grammar);

    # Catch errors in precomputation
    my $precompute_error_code = $Marpa::R2::Error::NONE;
    $grammar_c->throw_set(0);
    my $precompute_result = $grammar_c->precompute();
    $grammar_c->throw_set(1);

    if ( $precompute_result < 0 ) {
        ($precompute_error_code) = $grammar_c->error();
        if ( not defined $precompute_error_code ) {
            Marpa::R2::exception(
                'libmarpa error, but no error code returned');
        }

        # If already precomputed, let higher level know
        return $precompute_error_code
            if $precompute_error_code == $Marpa::R2::Error::PRECOMPUTED;

        # Cycles are not necessarily errors,
        # and get special handling
        $precompute_error_code = $Marpa::R2::Error::NONE
            if $precompute_error_code == $Marpa::R2::Error::GRAMMAR_HAS_CYCLE;

    } ## end if ( $precompute_result < 0 )

    if ( $precompute_error_code != $Marpa::R2::Error::NONE ) {

        # Report the errors, then return failure

        if ( $precompute_error_code == $Marpa::R2::Error::NO_RULES ) {
            Marpa::R2::exception(
                'Attempted to precompute grammar with no rules');
        }
        if ( $precompute_error_code == $Marpa::R2::Error::NULLING_TERMINAL ) {
            my @nulling_terminals = ();
            my $event_count       = $grammar_c->event_count();
            EVENT:
            for ( my $event_ix = 0; $event_ix < $event_count; $event_ix++ ) {
                my ( $event_type, $value ) = $grammar_c->event($event_ix);
                if ( $event_type eq 'MARPA_EVENT_NULLING_TERMINAL' ) {
                    push @nulling_terminals, $grammar->symbol_name($value);
                }
            } ## end EVENT: for ( my $event_ix = 0; $event_ix < $event_count; ...)
            my @nulling_terminal_messages =
                map {qq{Nulling symbol "$_" is also a terminal\n}}
                @nulling_terminals;
            Marpa::R2::exception( @nulling_terminal_messages,
                'A terminal symbol cannot also be a nulling symbol' );
        } ## end if ( $precompute_error_code == ...)
        if ( $precompute_error_code == $Marpa::R2::Error::COUNTED_NULLABLE ) {
            my @counted_nullables = ();
            my $event_count       = $grammar_c->event_count();
            EVENT:
            for ( my $event_ix = 0; $event_ix < $event_count; $event_ix++ ) {
                my ( $event_type, $value ) = $grammar_c->event($event_ix);
                if ( $event_type eq 'MARPA_EVENT_COUNTED_NULLABLE' ) {
                    push @counted_nullables, $grammar->symbol_name($value);
                }
            } ## end EVENT: for ( my $event_ix = 0; $event_ix < $event_count; ...)
            my @counted_nullable_messages = map {
                      q{Nullable symbol "}
                    . $_
                    . qq{" is on RHS of counted rule\n}
            } @counted_nullables;
            Marpa::R2::exception( @counted_nullable_messages,
                'Counted nullables confuse Marpa -- please rewrite the grammar'
            );
        } ## end if ( $precompute_error_code == ...)

        if ( $precompute_error_code == $Marpa::R2::Error::NO_START_SYMBOL ) {
            Marpa::R2::exception('No start symbol');
        }
        if ( $precompute_error_code == $Marpa::R2::Error::START_NOT_LHS ) {
            my $name = $grammar->[Marpa::R2::Internal::Grammar::START_NAME];
            Marpa::R2::exception(
                qq{Start symbol "$name" not on LHS of any rule});
        }

        return $precompute_error_code
            if $precompute_error_code
            == $Marpa::R2::Error::UNPRODUCTIVE_START;

        Marpa::R2::uncaught_error( scalar $grammar_c->error() );

    } ## end if ( $precompute_error_code != $Marpa::R2::Error::NONE)

    # Shadow all the new rules
    {
        my $highest_rule_id = $grammar_c->highest_rule_id();
        RULE:
        for ( my $rule_id = 0; $rule_id <= $highest_rule_id; $rule_id++ ) {
            next RULE if defined $rules->[$rule_id];

            # The Marpa::R2 logic assumes no "gaps" in the rule numbering,
            # which is currently the case for Libmarpa,
            # but not guaranteed.
            shadow_rule( $grammar, $rule_id );
        } ## end RULE: for ( my $rule_id = 0; $rule_id <= $highest_rule_id; ...)
    }

    my $infinite_action =
        $grammar->[Marpa::R2::Internal::Grammar::INFINITE_ACTION];

    # Above I went through the error events
    # Here I go through the events for situations where there was no
    # hard error returned from libmarpa
    my $loop_rule_count = 0;
    {
        my $event_count = $grammar_c->event_count();
        EVENT:
        for ( my $event_ix = 0; $event_ix < $event_count; $event_ix++ ) {
            my ( $event_type, $value ) = $grammar_c->event($event_ix);
            if ( $event_type ne 'MARPA_EVENT_LOOP_RULES' ) {
                Marpa::R2::exception(
                    qq{Unknown grammar precomputation event; type="$event_type"}
                );
            }
            $loop_rule_count = $value;
        } ## end EVENT: for ( my $event_ix = 0; $event_ix < $event_count; ...)
    }

    if ( $loop_rule_count and $infinite_action ne 'quiet' ) {
        my @loop_rules =
            grep { $grammar_c->rule_is_loop($_) } ( 0 .. $#{$rules} );
        for my $rule_id (@loop_rules) {
            print {$trace_fh}
                'Cycle found involving rule: ',
                $grammar->brief_rule($rule_id), "\n"
                or Marpa::R2::exception("Could not print: $ERRNO");
        } ## end for my $rule_id (@loop_rules)
        Marpa::R2::exception('Cycles in grammar, fatal error')
            if $infinite_action eq 'fatal';
    } ## end if ( $loop_rule_count and $infinite_action ne 'quiet')

    my $default_if_inaccessible =
        $grammar->[Marpa::R2::Internal::Grammar::INTERNAL]->{if_inaccessible}
        // 'warn';
    SYMBOL:
    for my $symbol_id ( grep { !$grammar_c->symbol_is_accessible($_) }
        ( 0 .. $#{$symbols} ) )
    {

        my $symbol      = $symbols->[$symbol_id];
        my $symbol_name = $grammar->symbol_name($symbol_id);

        # Inaccessible internal symbols may be created
        # from inaccessible use symbols -- ignore these.
        # This assumes that Marpa's logic
        # is correct and that
        # it is not creating inaccessible symbols from
        # accessible ones.
        next SYMBOL if $symbol_name =~ /\]/xms;
        my $treatment =
            $symbol->[Marpa::R2::Internal::Symbol::IF_INACCESSIBLE] //
            $default_if_inaccessible;
        next SYMBOL if $treatment eq 'ok';
        my $message = "Inaccessible symbol: $symbol_name";
        Marpa::R2::exception($message) if $treatment eq 'fatal';
        say {$trace_fh} $message
            or Marpa::R2::exception("Could not print: $ERRNO");
    } ## end for my $symbol_id ( grep { !$grammar_c->...})

    # A bit hackish here: UNPRODUCTIVE_OK is not a HASH ref iff
    # it is a Boolean TRUE indicating that all inaccessibles are OK.
    # A Boolean FALSE will have been replaced with an empty hash.
    if ($grammar->[Marpa::R2::Internal::Grammar::WARNINGS]
        and ref(
            my $ok = $grammar->[Marpa::R2::Internal::Grammar::UNPRODUCTIVE_OK]
        ) eq 'HASH'
        )
    {
        SYMBOL:
        for my $symbol (
            @{ Marpa::R2::Grammar::unproductive_symbols($grammar) } )
        {

            # Unproductive internal symbols may be created
            # from unproductive use symbols -- ignore these.
            # This assumes that Marpa's logic
            # is correct and that
            # it is not creating unproductive symbols from
            # productive ones.
            next SYMBOL if $symbol =~ /\]/xms;
            next SYMBOL if $ok->{$symbol};
            say {$trace_fh} "Unproductive symbol: $symbol"
                or Marpa::R2::exception("Could not print: $ERRNO");
        } ## end SYMBOL: for my $symbol ( @{ ...})
    } ## end if ( $grammar->[Marpa::R2::Internal::Grammar::WARNINGS...])

    my $cc_hash = $grammar->[Marpa::R2::Internal::Grammar::CHARACTER_CLASSES];
    if ( defined $cc_hash ) {
        my $class_table =
            $grammar->[Marpa::R2::Internal::Grammar::CHARACTER_CLASS_TABLE] =
            [];
        for my $cc_symbol ( sort keys %{$cc_hash} ) {
            my $cc_components = $cc_hash->{$cc_symbol};
            push @{$class_table},
                [ $grammar->thin_symbol($cc_symbol), $cc_components ];
        }
    } ## end if ( defined $cc_hash )

    # Save some memory
    $grammar->[Marpa::R2::Internal::Grammar::CHARACTER_CLASSES] = undef;

    return ;

} ## end sub Marpa::R2::Grammar::slif_precompute

sub Marpa::R2::Grammar::show_problems {
    my ($grammar) = @_;

    my $problems = $grammar->[Marpa::R2::Internal::Grammar::PROBLEMS];
    if ($problems) {
        my $problem_count = scalar @{$problems};
        return
            "Grammar has $problem_count problems:\n"
            . ( join "\n", @{$problems} ) . "\n";
    } ## end if ($problems)
    return "Grammar has no problems\n";
} ## end sub Marpa::R2::Grammar::show_problems

# Return DSL form of symbol
# Does no checking
sub Marpa::R2::Grammar::symbol_dsl_form {
    my ( $grammar, $symbol_id ) = @_;
    my $symbols   = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
    my $symbol = $symbols->[$symbol_id];
    return $symbol->[Marpa::R2::Internal::Symbol::DSL_FORM];
}

# Return description of symbol
# Does no checking
sub Marpa::R2::Grammar::symbol_description {
    my ( $grammar, $symbol_id ) = @_;
    my $symbols   = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
    my $symbol = $symbols->[$symbol_id];
    return $symbol->[Marpa::R2::Internal::Symbol::DESCRIPTION];
}

# Return display form of symbol
# Does lots of checking and makes use of alternatives.
sub Marpa::R2::Grammar::symbol_in_display_form {
    my ( $grammar, $symbol_id ) = @_;
    my $symbols   = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
    my $symbol = $symbols->[$symbol_id];
    return "<!No symbol with ID $symbol_id!>" if not defined $symbol;
    my $text = $symbol->[Marpa::R2::Internal::Symbol::DISPLAY_FORM];
    return $text if defined $text;
    $text = $symbol->[Marpa::R2::Internal::Symbol::DSL_FORM] //
     $grammar->symbol_name($symbol_id);
    return ($text =~ m/\s/xms) ? "<$text>" : $text;
}

sub Marpa::R2::Grammar::show_symbol {
    my ( $grammar, $symbol ) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my $text      = q{};
    my $symbol_id = $symbol->[Marpa::R2::Internal::Symbol::ID];

    my $name = $grammar->symbol_name($symbol_id);
    $text .= "$symbol_id: $name";

    my @tag_list = ();
    $grammar_c->symbol_is_productive($symbol_id)
        or push @tag_list, 'unproductive';
    $grammar_c->symbol_is_accessible($symbol_id)
        or push @tag_list, 'inaccessible';
    $grammar_c->symbol_is_nulling($symbol_id)  and push @tag_list, 'nulling';
    $grammar_c->symbol_is_terminal($symbol_id) and push @tag_list, 'terminal';

    $text .= join q{ }, q{,}, @tag_list if scalar @tag_list;
    $text .= "\n";
    return $text;

} ## end sub Marpa::R2::Grammar::show_symbol

sub Marpa::R2::Grammar::show_symbols {
    my ($grammar) = @_;
    my $symbols   = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
    my $text      = q{};
    for my $symbol_ref ( @{$symbols} ) {
        $text .= $grammar->show_symbol($symbol_ref);
    }
    return $text;
} ## end sub Marpa::R2::Grammar::show_symbols

sub Marpa::R2::Grammar::show_nulling_symbols {
    my ($grammar) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my $symbols   = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
    return join q{ }, sort map { $grammar->symbol_name($_) }
        grep { $grammar_c->symbol_is_nulling($_) } ( 0 .. $#{$symbols} );
} ## end sub Marpa::R2::Grammar::show_nulling_symbols

sub Marpa::R2::Grammar::show_productive_symbols {
    my ($grammar) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my $symbols   = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
    return join q{ }, sort map { $grammar->symbol_name($_) }
        grep { $grammar_c->symbol_is_productive($_) } ( 0 .. $#{$symbols} );
} ## end sub Marpa::R2::Grammar::show_productive_symbols

sub Marpa::R2::Grammar::show_accessible_symbols {
    my ($grammar) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my $symbols   = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
    return join q{ }, sort map { $grammar->symbol_name($_) }
        grep { $grammar_c->symbol_is_accessible($_) } ( 0 .. $#{$symbols} );
} ## end sub Marpa::R2::Grammar::show_accessible_symbols

sub Marpa::R2::Grammar::inaccessible_symbols {
    my ($grammar) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my $symbols   = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
    return [
        sort map { $grammar->symbol_name($_) }
            grep { !$grammar_c->symbol_is_accessible($_) }
            ( 0 .. $#{$symbols} )
    ];
} ## end sub Marpa::R2::Grammar::inaccessible_symbols

sub Marpa::R2::Grammar::unproductive_symbols {
    my ($grammar) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my $symbols   = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
    return [
        sort map { $grammar->symbol_name($_) }
            grep { !$grammar_c->symbol_is_productive($_) }
            ( 0 .. $#{$symbols} )
    ];
} ## end sub Marpa::R2::Grammar::unproductive_symbols

sub Marpa::R2::Grammar::start_symbol {
    my ( $grammar ) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    return $grammar_c->start_symbol();
}

sub Marpa::R2::Grammar::rule_name {
    my ( $grammar, $rule_id ) = @_;
    my $rules = $grammar->[Marpa::R2::Internal::Grammar::RULES];
    my $rule  = $rules->[$rule_id];
    return "Non-existent rule $rule_id" if not defined $rule;
    my $name = $rule->[Marpa::R2::Internal::Rule::NAME];
    return $name if defined $name;
    my $tracer    = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
    my ( $lhs_id ) = $tracer->rule_expand($rule_id);
    return $grammar->symbol_name($lhs_id);
} ## end sub Marpa::R2::Grammar::rule_name

# Undocumented -- assumes it is called internally,
# by the SLIF
sub Marpa::R2::Grammar::tag {
    my ( $grammar, $rule_id ) = @_;
    my $rules = $grammar->[Marpa::R2::Internal::Grammar::RULES];
    my $rule  = $rules->[$rule_id];
    return $rule->[Marpa::R2::Internal::Rule::SLIF_TAG];
} ## end sub Marpa::R2::Grammar::rule_name

sub Marpa::R2::Grammar::brief_rule {
    my ( $grammar, $rule_id ) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my ( $lhs, @rhs ) = $grammar->rule($rule_id);
    my $minimum = $grammar_c->sequence_min($rule_id);
    my $quantifier = defined $minimum ? $minimum <= 0 ? q{*} : q{+} : q{};
    return ( join q{ }, "$rule_id:", $lhs, '->', @rhs ) . $quantifier;
} ## end sub Marpa::R2::Grammar::brief_rule

sub Marpa::R2::Grammar::show_rule {
    my ( $grammar, $rule ) = @_;

    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my $rule_id   = $rule->[Marpa::R2::Internal::Rule::ID];
    my @comment   = ();

    $grammar_c->rule_length($rule_id) == 0 and push @comment, 'empty';
    $grammar->rule_is_used($rule_id)         or push @comment, '!used';
    $grammar_c->rule_is_productive($rule_id) or push @comment, 'unproductive';
    $grammar_c->rule_is_accessible($rule_id) or push @comment, 'inaccessible';
    $rule->[Marpa::R2::Internal::Rule::DISCARD_SEPARATION]
        and push @comment, 'discard_sep';

    my $text = $grammar->brief_rule($rule_id);

    if (@comment) {
        $text .= q{ } . ( join q{ }, q{/*}, @comment, q{*/} );
    }

    return $text .= "\n";

}    # sub show_rule

sub Marpa::R2::Grammar::show_rules {
    my ($grammar) = @_;
    my $rules = $grammar->[Marpa::R2::Internal::Grammar::RULES];
    my $text;

    for my $rule ( @{$rules} ) {
        $text .= $grammar->show_rule($rule);
    }
    return $text;
} ## end sub Marpa::R2::Grammar::show_rules

# This logic deals with gaps in the rule numbering.
# Currently there are none, but Libmarpa does not
# guarantee this.
sub Marpa::R2::Grammar::rule_ids {
    my ($grammar) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    return 0 .. $grammar_c->highest_rule_id();
} ## end sub Marpa::R2::Grammar::rule_ids

# This logic deals with gaps in the symbol numbering.
# Currently there are none, but Libmarpa does not
# guarantee this.
sub Marpa::R2::Grammar::symbol_ids {
    my ($grammar) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    return 0 .. $grammar_c->highest_symbol_id();
} ## end sub Marpa::R2::Grammar::rule_ids

# Returns empty array if not such rule
sub Marpa::R2::Grammar::rule {
    my ( $grammar, $rule_id ) = @_;
    my $symbols     = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
    my $tracer    = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
    my @symbol_names = ();

    my @symbols = $tracer->rule_expand($rule_id);
    SYMBOL_ID: for my $symbol_id (@symbols) {
        ## The name of the symbols, before the BNF rewrites
        my $name =
            $symbols->[$symbol_id]->[Marpa::R2::Internal::Symbol::LEGACY_NAME]
            // $grammar->symbol_name($symbol_id);
        push @symbol_names, $name;
    } ## end SYMBOL_ID: for my $symbol_id (@symbol_ids)
    return @symbol_names;
} ## end sub Marpa::R2::Grammar::rule

# Internal, for use with in coordinating thin and thick
# interfaces.  NOT DOCUMENTED.
sub Marpa::R2::Grammar::_rule_mask {
    my ( $grammar, $rule_id ) = @_;
    my $rules = $grammar->[Marpa::R2::Internal::Grammar::RULES];
    my $rule = $rules->[$rule_id];
    return $rule->[Marpa::R2::Internal::Rule::MASK];
} ## end sub Marpa::R2::Grammar::rule

# Deprecated and for removal
# Used in blog post, and part of
# CPAN version 2.023_008 but
# never documented in any CPAN version
sub Marpa::R2::Grammar::bnf_rule {
    goto &Marpa::R2::Grammar::rule;
} ## end sub Marpa::R2::Grammar::bnf_rule

sub Marpa::R2::Grammar::show_dotted_rule {
    my ( $grammar, $rule_id, $dot_position ) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my ( $lhs, @rhs ) = $grammar->rule($rule_id);

    my $minimum = $grammar_c->sequence_min($rule_id);
    if (defined $minimum) {
        my $quantifier = $minimum <= 0 ? q{*} : q{+} ;
        $rhs[0] .= $quantifier;
    }
    $dot_position = 0 if $dot_position < 0;
    splice @rhs, $dot_position, 0, q{.};
    return join q{ }, $lhs, q{->}, @rhs;
} ## end sub Marpa::R2::Grammar::show_dotted_rule

# Used by lexers to check that symbol is a terminal
sub Marpa::R2::Grammar::check_terminal {
    my ( $grammar, $name ) = @_;
    return 0 if not defined $name;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my $symbol_id =
        $grammar->[Marpa::R2::Internal::Grammar::TRACER]
        ->symbol_by_name($name);
    return 0 if not defined $symbol_id;
    my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
    my $symbol  = $symbols->[$symbol_id];
    return $grammar_c->symbol_is_terminal($symbol_id) ? 1 : 0;
} ## end sub Marpa::R2::Grammar::check_terminal

sub Marpa::R2::Grammar::symbol_name {
    my ( $grammar, $id ) = @_;
    my $symbol_name =
        $grammar->[Marpa::R2::Internal::Grammar::TRACER]->symbol_name($id);
    return defined $symbol_name ? $symbol_name : '[SYMBOL#' . $id . ']';
} ## end sub Marpa::R2::Grammar::symbol_name

sub shadow_symbol {
    my ( $grammar, $symbol_id ) = @_;
    my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
    my $symbol = $symbols->[$symbol_id] = [];
    $symbol->[Marpa::R2::Internal::Symbol::ID] = $symbol_id;
    return $symbol;
} ## end sub shadow_symbol

# Create the structure which "shadows" the libmarpa rule
sub shadow_rule {
    my ( $grammar, $rule_id ) = @_;
    my $rules = $grammar->[Marpa::R2::Internal::Grammar::RULES];
    my $new_rule = $rules->[$rule_id] = [];
    $new_rule->[Marpa::R2::Internal::Rule::ID] = $rule_id;
    return $new_rule;
} ## end sub shadow_rule

sub assign_symbol {
    my ( $grammar, $name, $options ) = @_;

    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my $tracer    = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
    my $symbol_id = $tracer->symbol_by_name($name);
    if ( defined $symbol_id ) {
        my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
        return $symbols->[$symbol_id];
    }
    $symbol_id = $tracer->symbol_new($name);
    my $symbol = shadow_symbol( $grammar, $symbol_id );

    PROPERTY: for my $property ( sort keys %{$options} ) {
        if ( $property eq 'semantics' ) {
            my $value = $options->{$property};
            $symbol->[Marpa::R2::Internal::Symbol::LEXEME_SEMANTICS] = $value;
            next PROPERTY;
        }
        if ( $property eq 'bless' ) {
            my $value = $options->{$property};
            $symbol->[Marpa::R2::Internal::Symbol::BLESSING] = $value;
            next PROPERTY;
        }
        if ( $property eq 'terminal' ) {
            my $value = $options->{$property};
            $grammar_c->symbol_is_terminal_set( $symbol_id, $value );
            next PROPERTY;
        }
        if ( $property eq 'rank' ) {
            my $value = $options->{$property};
            Marpa::R2::exception(qq{Symbol "$name": rank must be an integer})
                if not Scalar::Util::looks_like_number($value)
                    or int($value) != $value;
            $grammar_c->symbol_rank_set($symbol_id) = $value;
            next PROPERTY;
        } ## end if ( $property eq 'rank' )
        if ( $property eq 'description' ) {
            my $value = $options->{$property};
            $symbol->[Marpa::R2::Internal::Symbol::DESCRIPTION] = $value;
            next PROPERTY;
        }
        if ( $property eq 'dsl_form' ) {
            my $value = $options->{$property};
            $symbol->[Marpa::R2::Internal::Symbol::DSL_FORM] = $value;
            next PROPERTY;
        }
        if ( $property eq 'legacy_name' ) {
            my $value = $options->{$property};
            $symbol->[Marpa::R2::Internal::Symbol::LEGACY_NAME] = $value;
            next PROPERTY;
        }
        if ( $property eq 'display_form' ) {
            my $value = $options->{$property};
            $symbol->[Marpa::R2::Internal::Symbol::DISPLAY_FORM] = $value;
            next PROPERTY;
        }
        if ( $property eq 'if_inaccessible' ) {
            my $value = $options->{$property};
            $symbol->[Marpa::R2::Internal::Symbol::IF_INACCESSIBLE] = $value;
            next PROPERTY;
        }
        Marpa::R2::exception(qq{Unknown symbol property "$property"});
    } ## end PROPERTY: for my $property ( keys %{$options} )

    return $symbol;

} ## end sub assign_symbol

sub assign_user_symbol {
    my $grammar   = shift;
    my $name      = shift;
    my $options   = shift;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];

    if ( my $type = ref $name ) {
        Marpa::R2::exception(
            "Symbol name was ref to $type; it must be a scalar string");
    }
    if ( not $grammar->[Marpa::R2::Internal::Grammar::INTERNAL] ) {
        my $final_symbol = substr $name, -1;
        if ( $DEFAULT_SYMBOLS_RESERVED{$final_symbol} ) {
            Marpa::R2::exception(
                qq{Symbol name $name ends in "$final_symbol": that's not allowed}
            );
        }
    } ## end if ( not $grammar->[Marpa::R2::Internal::Grammar::INTERNAL...])
    my $symbol = assign_symbol( $grammar, $name, $options );

    return $symbol;

} ## end sub assign_user_symbol

# add one or more rules
sub add_user_rules {
    my ( $grammar, $rules ) = @_;

    my @hash_rules = ();
    RULE: for my $rule ( @{$rules} ) {

        # Translate other rule formats into hash rules
        my $ref_rule = ref $rule;
        if ( $ref_rule eq 'HASH' ) {
            push @hash_rules, $rule;
            next RULE;
        }
        if ( $ref_rule eq 'ARRAY' ) {
            my $arg_count = @{$rule};

            if ( $arg_count > 4 or $arg_count < 1 ) {
                Marpa::R2::exception(
                    "Rule has $arg_count arguments: "
                        . join( ', ',
                        map { defined $_ ? $_ : 'undef' } @{$rule} )
                        . "\n"
                        . 'Rule must have from 1 to 4 arguments'
                );
            } ## end if ( $arg_count > 4 or $arg_count < 1 )
            my ( $lhs, $rhs, $action ) = @{$rule};
            push @hash_rules,
                {
                lhs           => $lhs,
                rhs           => $rhs,
                action        => $action,
                };
            next RULE;
        } ## end if ( $ref_rule eq 'ARRAY' )
        Marpa::R2::exception(
            'Invalid rule: ',
            Data::Dumper->new( [$rule], ['Invalid_Rule'] )->Indent(2)
                ->Terse(1)->Maxdepth(2)->Dump,
            'Rule must be ref to HASH or ARRAY'
        );

    }    # RULE

    for my $hash_rule (@hash_rules) {
        add_user_rule( $grammar, $hash_rule );
    }

    return;

} ## end sub add_user_rules

sub add_user_rule {
    my ( $grammar, $options ) = @_;

    Marpa::R2::exception('Missing argument to add_user_rule')
        if not defined $grammar
        or not defined $options;

    my $grammar_c    = $grammar->[Marpa::R2::Internal::Grammar::C];
    my $tracer       = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
    my $rules        = $grammar->[Marpa::R2::Internal::Grammar::RULES];
    my $default_rank = $grammar_c->default_rank();

    my ( $lhs_name, $rhs_names, $action, $blessing );
    my ( $min, $separator_name );
    my $rank;
    my $null_ranking;
    my $rule_name;
    my $slif_tag;
    my $mask;
    my $proper_separation = 0;
    my $keep_separation   = 0;
    my $description;

    OPTION: for my $option ( keys %{$options} ) {
        my $value = $options->{$option};
        if ( $option eq 'name' )   { $rule_name = $value; next OPTION; }
        if ( $option eq 'tag' )    { $slif_tag  = $value; next OPTION; }
        if ( $option eq 'rhs' )    { $rhs_names = $value; next OPTION }
        if ( $option eq 'lhs' )    { $lhs_name  = $value; next OPTION }
        if ( $option eq 'action' ) { $action    = $value; next OPTION }
        if ( $option eq 'bless' )  { $blessing  = $value; next OPTION }
        if ( $option eq 'rank' )   { $rank      = $value; next OPTION }
        if ( $option eq 'null_ranking' ) {
            $null_ranking = $value;
            next OPTION;
        }
        if ( $option eq 'min' ) { $min = $value; next OPTION }
        if ( $option eq 'separator' ) {
            $separator_name = $value;
            next OPTION;
        }
        if ( $option eq 'proper' ) {
            $proper_separation = $value;
            next OPTION;
        }
        if ( $option eq 'keep' ) { $keep_separation = $value; next OPTION }
        if ( $option eq 'mask' ) { $mask            = $value; next OPTION }
        if ( $option eq 'description' ) { $description = $value; next OPTION }
        Marpa::R2::exception("Unknown user rule option: $option");
    } ## end OPTION: for my $option ( keys %{$options} )

    if ( defined $min and not Scalar::Util::looks_like_number($min) ) {
        Marpa::R2::exception(
            q{"min" must be undefined or a valid Perl number});
    }
    my $stuifzand_interface =
        $grammar->[Marpa::R2::Internal::Grammar::INTERFACE] eq 'stuifzand';

    my $grammar_is_internal = $stuifzand_interface
        || $grammar->[Marpa::R2::Internal::Grammar::INTERNAL];

    my $lhs =
        $grammar_is_internal
        ? assign_symbol( $grammar, $lhs_name )
        : assign_user_symbol( $grammar, $lhs_name );
    $rhs_names //= [];

    my @rule_problems = ();

    my $rhs_ref_type = ref $rhs_names;
    if ( not $rhs_ref_type or $rhs_ref_type ne 'ARRAY' ) {
        my $problem =
              "RHS is not ref to ARRAY\n"
            . '  Type of rhs is '
            . ( $rhs_ref_type ? $rhs_ref_type : 'not a ref' ) . "\n";
        my $d = Data::Dumper->new( [$rhs_names], ['rhs'] );
        $problem .= $d->Dump();
        push @rule_problems, $problem;
    } ## end if ( not $rhs_ref_type or $rhs_ref_type ne 'ARRAY' )
    if ( not defined $lhs_name ) {
        push @rule_problems, "Missing LHS\n";
    }

    if ( defined $rank
        and
        ( not Scalar::Util::looks_like_number($rank) or int($rank) != $rank )
        )
    {
        push @rule_problems, "Rank must be undefined or an integer\n";
    } ## end if ( defined $rank and ( not Scalar::Util::looks_like_number...))
    $rank //= $default_rank;

    $null_ranking //= 'low';
    if ( $null_ranking ne 'high' and $null_ranking ne 'low' ) {
        push @rule_problems,
            "Null Ranking must be undefined, 'high' or 'low'\n";
    }

    if ( scalar @rule_problems ) {
        my %dump_options = %{$options};
        delete $dump_options{grammar};
        my $msg = ( scalar @rule_problems )
            . " problem(s) in the following rule:\n";
        my $d = Data::Dumper->new( [ \%dump_options ], ['rule'] );
        $msg .= $d->Dump();
        for my $problem_number ( 0 .. $#rule_problems ) {
            $msg
                .= 'Problem '
                . ( $problem_number + 1 ) . q{: }
                . $rule_problems[$problem_number] . "\n";
        } ## end for my $problem_number ( 0 .. $#rule_problems )
        Marpa::R2::exception($msg);
    } ## end if ( scalar @rule_problems )

    my $rhs = [
        map {
            $grammar_is_internal
                ? assign_symbol( $grammar, $_ )
                : assign_user_symbol( $grammar, $_ );
        } @{$rhs_names}
    ];

    # Is this is an ordinary, non-counted rule?
    my $is_ordinary_rule = scalar @{$rhs_names} == 0 || !defined $min;
    if ( defined $separator_name and $is_ordinary_rule ) {
        if ( defined $separator_name ) {
            Marpa::R2::exception(
                'separator defined for rule without repetitions');
        }
    } ## end if ( defined $separator_name and $is_ordinary_rule )

    my @rhs_ids = map { $_->[Marpa::R2::Internal::Symbol::ID] } @{$rhs};
    my $lhs_id = $lhs->[Marpa::R2::Internal::Symbol::ID];

    my $base_rule_id;
    my $separator_id = -1;

    if ($is_ordinary_rule) {

        # Capture errors
        $grammar_c->throw_set(0);
        $base_rule_id = $grammar_c->rule_new( $lhs_id, \@rhs_ids );
        $grammar_c->throw_set(1);

    } ## end if ($is_ordinary_rule)
    else {
        Marpa::R2::exception('Only one rhs symbol allowed for counted rule')
            if scalar @{$rhs_names} != 1;

        # create the separator symbol, if we're using one
        if ( defined $separator_name ) {
            my $separator =
                $grammar_is_internal
                ? assign_symbol( $grammar, $separator_name )
                : assign_user_symbol( $grammar, $separator_name );
            $separator_id = $separator->[Marpa::R2::Internal::Symbol::ID];
        } ## end if ( defined $separator_name )

        $grammar_c->throw_set(0);

        # The original rule for a sequence rule is
        # not actually used in parsing,
        # but some of the rewritten sequence rules are its
        # semantic equivalents.

        $base_rule_id = $grammar_c->sequence_new(
            $lhs_id,
            $rhs_ids[0],
            {   separator => $separator_id,
                proper    => $proper_separation,
                min       => $min,
            }
        );
        $grammar_c->throw_set(1);
    } ## end else [ if ($is_ordinary_rule) ]

    if ( not defined $base_rule_id or $base_rule_id < 0 ) {
        my $rule_description = rule_describe( $lhs_name, $rhs_names );
        my ( $error_code, $error_string ) = $grammar_c->error();
        $error_code //= -1;
        my $problem_description =
            $error_code == $Marpa::R2::Error::DUPLICATE_RULE
            ? 'Duplicate rule'
            : $error_string;
        Marpa::R2::exception("$problem_description: $rule_description");
    } ## end if ( not defined $base_rule_id or $base_rule_id < 0 )

    my $base_rule = shadow_rule( $grammar, $base_rule_id );

    if ($is_ordinary_rule) {

        # Only internal grammars can set a custom mask
        if ( not defined $mask or not $grammar_is_internal ) {
            $mask = [ (1) x scalar @rhs_ids ];
        }
        $base_rule->[Marpa::R2::Internal::Rule::MASK] = $mask;
    } ## end if ($is_ordinary_rule)

    $base_rule->[Marpa::R2::Internal::Rule::DISCARD_SEPARATION] =
        $separator_id >= 0 && !$keep_separation;

    $base_rule->[Marpa::R2::Internal::Rule::ACTION_NAME] = $action;
    $grammar_c->rule_null_high_set( $base_rule_id,
        ( $null_ranking eq 'high' ? 1 : 0 ) );
    $grammar_c->rule_rank_set( $base_rule_id, $rank );

    if ( defined $rule_name ) {
        $base_rule->[Marpa::R2::Internal::Rule::NAME] = $rule_name;
    }
    if ( defined $slif_tag ) {
        $base_rule->[Marpa::R2::Internal::Rule::SLIF_TAG] = $slif_tag;
        my $rule_id_by_tag =
            $grammar->[Marpa::R2::Internal::Grammar::RULE_ID_BY_TAG];
        if ( $rule_id_by_tag->{$slif_tag} ) {
            Marpa::R2::exception(
                qq{Duplicate tag in SLIF rule, tag was "$slif_tag"});
        }
        $rule_id_by_tag->{$slif_tag} = $base_rule_id;
    } ## end if ( defined $slif_tag )
    if ( defined $blessing ) {
        $base_rule->[Marpa::R2::Internal::Rule::BLESSING] = $blessing;
    }
    if ( defined $description ) {
        $base_rule->[Marpa::R2::Internal::Rule::DESCRIPTION] = $description;
    }

    return;

} ## end sub add_user_rule

sub rule_describe {
    my ( $lhs_name, $rhs_names ) = @_;
    # wrap symbol names with whitespaces allowed by SLIF
    $lhs_name = "<$lhs_name>" if $lhs_name =~ / /;
    return "$lhs_name -> " . ( join q{ }, map { / / ? "<$_>" : $_ } @{$rhs_names} );
} ## end sub rule_describe

sub set_start_symbol {
    my $grammar = shift;

    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    state $default_start_name = '[:start]';
    my $tracer           = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
    my $default_start_id = $tracer->symbol_by_name($default_start_name);
    my $start_id;
    VALIDATE_START_NAME: {
        my $named_arg_start_name =
            $grammar->[Marpa::R2::Internal::Grammar::START_NAME];
        if ( defined $named_arg_start_name and defined $start_id ) {
            Marpa::R2::exception(
                qq{Start symbol specified as '[:start]', but also with named argument\n},
                qq{   You must use one or the other\n}
            );
        } ## end if ( defined $named_arg_start_name and defined $start_id)
        if ( defined $named_arg_start_name ) {
            $start_id = $tracer->symbol_by_name($named_arg_start_name);
            Marpa::R2::exception(
                qq{Start symbol "$named_arg_start_name" not in grammar})
                if not defined $start_id;
            last VALIDATE_START_NAME;
        } ## end if ( defined $named_arg_start_name )
        if ( defined $default_start_id ) {
            $start_id = $default_start_id;
            $grammar->[Marpa::R2::Internal::Grammar::START_NAME] =
                $named_arg_start_name;
            last VALIDATE_START_NAME;
        } ## end if ( defined $default_start_id )
        Marpa::R2::exception(qq{No start symbol specified in grammar\n});
    } ## end VALIDATE_START_NAME:

    if ( not defined $grammar_c->start_symbol_set($start_id) ) {
        Marpa::R2::uncaught_error( $grammar_c->error() );
    }
    return 1;
} ## end sub set_start_symbol

sub Marpa::R2::Grammar::error {
    my ($grammar) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    return $grammar_c->error();
}

# INTERNAL OK AFTER HERE _marpa_

sub Marpa::R2::Grammar::show_isy {
    my ( $grammar, $isy_id ) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my $tracer    = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
    my $text      = q{};

    my $name = $tracer->isy_name($isy_id);
    $text .= "$isy_id: $name";

    my @tag_list = ();
    $grammar_c->_marpa_g_nsy_is_nulling($isy_id)
        and push @tag_list, 'nulling';

    $text .= join q{ }, q{,}, @tag_list if scalar @tag_list;
    $text .= "\n";

    return $text;

} ## end sub Marpa::R2::Grammar::show_isy

sub Marpa::R2::Grammar::show_isys {
    my ($grammar) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my $text      = q{};
    for my $isy_id ( 0 .. $grammar_c->_marpa_g_nsy_count() - 1 ) {
        $text .= $grammar->show_isy($isy_id);
    }
    return $text;
} ## end sub Marpa::R2::Grammar::show_isys

sub Marpa::R2::Grammar::brief_irl {
    my ( $grammar, $irl_id ) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my $tracer    = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
    my $lhs_id    = $grammar_c->_marpa_g_irl_lhs($irl_id);
    my $text = $irl_id . ': ' . $tracer->isy_name($lhs_id) . ' ->';
    if ( my $rh_length = $grammar_c->_marpa_g_irl_length($irl_id) ) {
        my @rhs_ids = ();
        for my $ix ( 0 .. $rh_length - 1 ) {
            push @rhs_ids, $grammar_c->_marpa_g_irl_rhs( $irl_id, $ix );
        }
        $text .= q{ } . ( join q{ }, map { $tracer->isy_name($_) } @rhs_ids );
    } ## end if ( my $rh_length = $grammar_c->_marpa_g_irl_length...)
    return $text;
} ## end sub Marpa::R2::Grammar::brief_irl

sub Marpa::R2::Grammar::show_irls {
    my ($grammar) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    my $text      = q{};
    for my $irl_id ( 0 .. $grammar_c->_marpa_g_irl_count() - 1 ) {
        $text .= $grammar->brief_irl($irl_id) . "\n";
    }
    return $text;
} ## end sub Marpa::R2::Grammar::show_irls

sub Marpa::R2::Grammar::rule_is_used {
    my ( $grammar, $rule_id ) = @_;
    my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
    return $grammar_c->_marpa_g_rule_is_used($rule_id);
}

sub Marpa::R2::Grammar::show_ahms {
    my ( $grammar, $verbose ) = @_;
    return $grammar->[Marpa::R2::Internal::Grammar::TRACER]
        ->show_ahms($verbose);
}

1;

# vim: expandtab shiftwidth=4: