File Coverage

blib/lib/Marpa/R3/SLV.pm

Criterion	Covered	Total	%
statement	333	372	89.5
branch	76	106	71.7
condition	20	36	55.5
subroutine	34	38	89.4
pod			n/a
total	463	552	83.8

# Marpa::R3 is Copyright (C) 2018, Jeffrey Kegler.
#
# This module is free software; you can redistribute it and/or modify it
# under the same terms as Perl 5.10.1. For more details, see the full text
# of the licenses in the directory LICENSES.
#
# This program is distributed in the hope that it will be
# useful, but it is provided "as is" and without any express
# or implied warranties. For details, see the full text of
# of the licenses in the directory LICENSES.

package Marpa::R3::Valuer;

use 5.010001;
use strict;
use warnings;

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

package Marpa::R3::Internal_V;

use Scalar::Util qw(blessed tainted);
use English qw( -no_match_vars );

our $PACKAGE = 'Marpa::R3::Valuer';

# Set those common args which are at the Perl level.
sub slv_common_set {
    my ( $slv, $flat_args ) = @_;
    if ( my $value = $flat_args->{'trace_file_handle'} ) {
        $slv->[Marpa::R3::Internal_V::TRACE_FILE_HANDLE] = $value;
    }
    my $trace_file_handle =
      $slv->[Marpa::R3::Internal_V::TRACE_FILE_HANDLE];
    delete $flat_args->{'trace_file_handle'};
    return $flat_args;
}

our $CONTEXT_EXCEPTION_CLASS = __PACKAGE__ . '::Context_Exception';

sub Marpa::R3::Context::bail {   ## no critic (Subroutines::RequireArgUnpacking)
    if ( scalar @_ == 1 and ref $_[0] ) {
        die bless { exception_object => $_[0] }, $CONTEXT_EXCEPTION_CLASS;
    }
    my $error_string = join q{}, @_;
    my ( $package, $filename, $line ) = caller;
    chomp $error_string;
    die bless { message => qq{User bailed at line $line in file "$filename"\n}
          . $error_string
          . "\n" }, $CONTEXT_EXCEPTION_CLASS;
} ## end sub Marpa::R3::Context::bail
## use critic

sub Marpa::R3::Context::g1_range {
    my $slv = $Marpa::R3::Context::valuer;
    my ( $start, $end ) =
      $slv->call_by_tag( ( '@' . __FILE__ . ':' . __LINE__ ), <<'END_OF_LUA', '>*' );
local slv = ...
return slv:g1_range()
END_OF_LUA
    return $start, $end;
} ## end sub Marpa::R3::Context::g1_range

sub Marpa::R3::Context::lc_range {
    my $slv = $Marpa::R3::Context::valuer;
    my ( $lc_range ) =
      $slv->call_by_tag( ( '@' . __FILE__ . ':' . __LINE__ ), <<'END_OF_LUA', '>*' );
local slv = ...
local slr = slv.slr
local g1_first, g1_last = slv:g1_range()
local l0_first_b, l0_first_p = slr:g1_to_block_first(g1_first)
local l0_last_b, l0_last_p = slr:g1_to_block_last(g1_last)
return slr:lc_range_brief(l0_first_b, l0_first_p, l0_last_b, l0_last_p)
END_OF_LUA
    return $lc_range;
}

sub Marpa::R3::Context::g1_span {
    my $slv = $Marpa::R3::Context::valuer;
    my ( $start, $length ) =
      $slv->call_by_tag( ( '@' . __FILE__ . ':' . __LINE__ ), <<'END_OF_LUA', '>*' );
local slv = ...
local g1_first, g1_last = slv:g1_range()
local length = g1_last - g1_first + 1
return start, length
END_OF_LUA
    return $start, $length;
}

sub code_problems {
    my $args = shift;

    my $grammar;
    my $fatal_error;
    my $warnings = [];
    my $where    = '?where?';
    my $long_where;
    my @msg = ();
    my $eval_value;
    my $eval_given = 0;

    push @msg, q{=} x 60, "\n";
  ARG: for my $arg ( keys %{$args} ) {
        my $value = $args->{$arg};
        if ( $arg eq 'fatal_error' ) { $fatal_error = $value; next ARG }
        if ( $arg eq 'grammar' )     { $grammar     = $value; next ARG }
        if ( $arg eq 'where' )       { $where       = $value; next ARG }
        if ( $arg eq 'long_where' )  { $long_where  = $value; next ARG }
        if ( $arg eq 'warnings' )    { $warnings    = $value; next ARG }
        if ( $arg eq 'eval_ok' ) {
            $eval_value = $value;
            $eval_given = 1;
            next ARG;
        }
        push @msg, "Unknown argument to code_problems: $arg";
    } ## end ARG: for my $arg ( keys %{$args} )

  GIVEN_FATAL_ERROR_REF_TYPE: {
        my $fatal_error_ref_type = ref $fatal_error;
        last GIVEN_FATAL_ERROR_REF_TYPE if not $fatal_error_ref_type;
        if ( $fatal_error_ref_type eq $CONTEXT_EXCEPTION_CLASS ) {
            my $exception_object = $fatal_error->{exception_object};
            die $exception_object if defined $exception_object;
            my $exception_message = $fatal_error->{message};
            die $exception_message if defined $exception_message;
            die "Internal error: bad $CONTEXT_EXCEPTION_CLASS object";
        } ## end if ( $fatal_error_ref_type eq $CONTEXT_EXCEPTION_CLASS)
        $fatal_error =
            "Exception thrown as object inside Marpa closure\n"
          . ( q{ } x 4 )
          . "This is not allowed\n"
          . ( q{ } x 4 )
          . qq{Exception as string is "$fatal_error"};
    } ## end GIVEN_FATAL_ERROR_REF_TYPE:

    my @problem_line     = ();
    my $max_problem_line = -1;
    for my $warning_data ( @{$warnings} ) {
        my ( $warning, $package, $filename, $problem_line ) = @{$warning_data};
        $problem_line[$problem_line] = 1;
        $max_problem_line = List::Util::max $problem_line, $max_problem_line;
    } ## end for my $warning_data ( @{$warnings} )

    $long_where //= $where;

    my $warnings_count = scalar @{$warnings};
    {
        my @problems;
        my $false_eval = $eval_given && !$eval_value && !$fatal_error;
        if ($false_eval) {
            push @problems, '* THE MARPA SEMANTICS RETURNED A PERL FALSE',
              'Marpa::R3 requires its semantics to return a true value';
        }
        if ($fatal_error) {
            push @problems, '* THE MARPA SEMANTICS PRODUCED A FATAL ERROR';
        }
        if ($warnings_count) {
            push @problems,
              "* THERE WERE $warnings_count WARNING(S) IN THE MARPA SEMANTICS:",
              'Marpa treats warnings as fatal errors';
        }
        if ( not scalar @problems ) {
            push @msg, '* THERE WAS A FATAL PROBLEM IN THE MARPA SEMANTICS';
        }
        push @msg, ( join "\n", @problems ) . "\n";
    }

    push @msg, "* THIS IS WHAT MARPA WAS DOING WHEN THE PROBLEM OCCURRED:\n"
      . $long_where . "\n";

    for my $warning_ix ( 0 .. ( $warnings_count - 1 ) ) {
        push @msg, "* WARNING MESSAGE NUMBER $warning_ix:\n";
        my $warning_message = $warnings->[$warning_ix]->[0];
        $warning_message =~ s/\n*\z/\n/xms;
        push @msg, $warning_message;
    } ## end for my $warning_ix ( 0 .. ( $warnings_count - 1 ) )

    if ($fatal_error) {
        push @msg, "* THIS WAS THE FATAL ERROR MESSAGE:\n";
        my $fatal_error_message = $fatal_error;
        $fatal_error_message =~ s/\n*\z/\n/xms;
        push @msg, $fatal_error_message;
    } ## end if ($fatal_error)

    Marpa::R3::exception(@msg);

    # this is to keep perlcritic happy
    return 1;

}

sub Marpa::R3::Valuer::new {
    my ( $class, @args ) = @_;

    my $slv = [];

    # Set recognizer args to default
    # Lua equivalent is set below

    my ( $flat_args, $error_message ) = Marpa::R3::flatten_hash_args( \@args );
    Marpa::R3::exception( sprintf $error_message, '$slv->new' )
      if not $flat_args;
    $flat_args = slv_common_set( $slv, $flat_args );

    my $slr = $flat_args->{recognizer};
    Marpa::R3::exception(
        qq{Marpa::R3::Valuer::new() called without a "recognizer" argument} )
      if not defined $slr;
    $slv->[Marpa::R3::Internal_V::SLR] = $slr;
    delete $flat_args->{recognizer};

    my $slr_class = 'Marpa::R3::Recognizer';
    if ( not blessed $slr or not $slr->isa($slr_class) ) {
        my $ref_type = ref $slr;
        my $desc = $ref_type ? "a ref to $ref_type" : 'not a ref';
        Marpa::R3::exception(
            qq{'recognizer' named argument to new() is $desc\n},
            "  It should be a ref to $slr_class\n"
        );
    }

    $slv->[Marpa::R3::Internal_V::TRACE_FILE_HANDLE] //=
      $slr->[Marpa::R3::Internal_R::TRACE_FILE_HANDLE];

    my $trace_file_handle =
      $slv->[Marpa::R3::Internal_V::TRACE_FILE_HANDLE];

    my $lua = $slr->[Marpa::R3::Internal_R::L];
    $slv->[Marpa::R3::Internal_V::L] = $lua;

    my ( $regix ) = $slr->coro_by_tag(
        ( '@' . __FILE__ . ':' . __LINE__ ),
        {
            signature => 's',
            args      => [$flat_args],
            handlers  => {
                trace => sub {
                    my ($msg) = @_;
                    say {$trace_file_handle} $msg;
                    return 'ok';
                },
            }
        },
        <<'END_OF_LUA');
        local slr, flat_args = ...
        _M.wrap(function ()
            local slv = slr:slv_new(flat_args)
            if not slv then return 'ok', -1 end
            return 'ok', slv.regix
        end)
END_OF_LUA

    return if $regix < 0;
    $slv->[Marpa::R3::Internal_V::REGIX]  = $regix;

    return bless $slv, $class;
}

sub Marpa::R3::Valuer::DESTROY {
    # say STDERR "In Marpa::R3::Valuer::DESTROY before test";
    my $slv = shift;
    my $lua = $slv->[Marpa::R3::Internal_V::L];

    # If we are destroying the Perl interpreter, then all the Marpa
    # objects will be destroyed, including Marpa's Lua interpreter.
    # We do not need to worry about cleaning up the
    # recognizer is an orderly manner, because the Lua interpreter
    # containing the recognizer will be destroyed.
    # In fact, the Lua interpreter may already have been destroyed,
    # so this test is necessary to avoid a warning message.
    return if not $lua;
    # say STDERR "In Marpa::R3::Valuer::DESTROY after test";

    my $regix = $slv->[Marpa::R3::Internal_V::REGIX];
    $slv->call_by_tag(
        ('@' . __FILE__ . ':' . __LINE__),
        <<'END_OF_LUA', '');
    local slv = ...
    local regix = slv.regix
    _M.unregister(_M.registry, regix)
END_OF_LUA
}

sub Marpa::R3::Valuer::set {
    my ( $slv, @args ) = @_;

    my ($flat_args, $error_message) = Marpa::R3::flatten_hash_args(\@args);
    Marpa::R3::exception( sprintf $error_message, '$slv->set()' ) if not $flat_args;
    $flat_args = slv_common_set($slv, $flat_args);
    my $trace_file_handle =
      $slv->[Marpa::R3::Internal_V::TRACE_FILE_HANDLE];

    $slv->coro_by_tag(
        ( '@' . __FILE__ . ':' . __LINE__ ),
        {
            signature => 's',
            args      => [ $flat_args ],
            handlers  => {
                trace => sub {
                    my ($msg) = @_;
                    say {$trace_file_handle} $msg;
                    return 'ok';
                }
            }
        },
        <<'END_OF_LUA');
        local slv, flat_args = ...
        return _M.wrap(function ()
                slv:common_set(flat_args)
            end
        )
END_OF_LUA
    return;
}

# Returns false if no parse
sub Marpa::R3::Valuer::value {
    my ( $slv, $per_parse_arg ) = @_;
    my $slr    = $slv->[Marpa::R3::Internal_V::SLR];
    my $slg    = $slr->[Marpa::R3::Internal_R::SLG];

    my $trace_actions =
      $slg->[Marpa::R3::Internal_G::TRACE_ACTIONS] // 0;
    my $trace_file_handle =
      $slv->[Marpa::R3::Internal_V::TRACE_FILE_HANDLE];

    my $semantics_arg0 = $per_parse_arg // {};
    my $constants = $slg->[Marpa::R3::Internal_G::CONSTANTS];
    my $null_values = $slg->[Marpa::R3::Internal_G::NULL_VALUES];
    my $nulling_closures =
      $slg->[Marpa::R3::Internal_G::CLOSURE_BY_SYMBOL_ID];
    my $rule_closures =
      $slg->[Marpa::R3::Internal_G::CLOSURE_BY_RULE_ID];

    local $Marpa::R3::Context::rule = undef;
    local $Marpa::R3::Context::irlid = undef;
    local $Marpa::R3::Context::grammar = $slg;
    local $Marpa::R3::Context::recognizer  = $slr;
    local $Marpa::R3::Context::valuer  = $slv;

    my %value_handlers = (
        trace => sub {
            my ($msg) = @_;
            my $nl = ( $msg =~ /\n\z/xms ) ? '' : "\n";
            print {$trace_file_handle} $msg, $nl;
            return 'ok';
        },
        terse_dump => sub {
            my ($value) = @_;
            my $dumped = Data::Dumper->new( [$value] )->Terse(1)->Dump;
            chomp $dumped;
            return 'ok', $dumped;
        },
        constant => sub {
            my ($constant_ix) = @_;
            my $constant = $constants->[$constant_ix];
            return 'sig', [ 'S', $constant ];
        },
        perl_undef => sub {
            return 'sig', [ 'S', undef ];
        },
        bless => sub {
            my ( $value, $blessing_ix ) = @_;
            my $blessing_data = $constants->[$blessing_ix];
            my ( $irlid, $lexeme_id, $blessing ) = @{$blessing_data};
            my $lexeme_name;
            if ( defined $lexeme_id ) {
                $lexeme_name = $slg->g1_symbol_name($lexeme_id);
            }
            else {
                $lexeme_name = "[IRL# $irlid]";
            }

          FIND_BASE_BLESSING: {
                if ( $blessing eq '::name' ) {
                    if ( $lexeme_name =~ / [^ [:alnum:]] /xms ) {
                        Marpa::R3::exception(
qq{Lexeme blessing by '::name' only allowed if lexeme name is whitespace and alphanumerics\n},
                            qq{   Problematic lexeme was <$lexeme_name>\n}
                        );
                    } ## end if ( $lexeme_name =~ / [^ [:alnum:]] /xms )
                    $blessing = $lexeme_name;
                    $blessing =~ s/[ ]/_/gxms;
                    last FIND_BASE_BLESSING;
                } ## end if ( $default_blessing eq '::name' )
                if ( $blessing =~ /^ :: /xms ) {
                    Marpa::R3::exception(
                        qq{Blessing lexeme as '$blessing' is not allowed\n},
qq{   It is in pseudo-blessing form, but there is no such psuedo-blessing\n},
                        qq{   Problematic lexeme was <$lexeme_name>\n}
                    );
                }
                if ( $blessing =~ / [\W] /xms ) {
                    Marpa::R3::exception(
                        qq{Blessing lexeme as '$blessing' is not allowed\n},
qq{   It contained non-word characters and that is not allowed\n},
                        qq{   Problematic lexeme was <$lexeme_name>\n}
                    );
                } ## end if ( $default_blessing =~ / [\W] /xms )
            }

            if ( $blessing !~ / :: /xms ) {
                my $bless_package =
                  $slg->[Marpa::R3::Internal_G::BLESS_PACKAGE];
                if ( not defined $bless_package ) {
                    Marpa::R3::exception(
                        qq{Blessing package needed, but grammar has none\n},
                        qq{  The blessing was "$blessing"\n} );
                } ## end if ( not defined $bless_package )
                $blessing = $bless_package . q{::} . $blessing;
            }
            return 'sig', [ 'S', ( bless $value, $blessing ) ];
          },
        perl_nulling_semantics => sub {
            my ($token_id) = @_;
            my $value_ref = $nulling_closures->[$token_id];
            my $result;
            my @warnings;
            my $eval_ok;
          DO_EVAL: {
                local $SIG{__WARN__} = sub {
                    push @warnings, [ $_[0], ( caller 0 ) ];
                };
                $eval_ok = eval {
                    my $irlid = $null_values->[$token_id];
                    local $Marpa::R3::Context::irlid = $irlid;
                    local $Marpa::R3::Context::production_id =
                      $slg->g1_rule_to_production_id($irlid);
                    $result = $value_ref->( $semantics_arg0, [] );
                    1;
                };
            } ## end DO_EVAL:
            if ( not $eval_ok or @warnings ) {
                my $fatal_error = $EVAL_ERROR;
                code_problems(
                    {
                        fatal_error => $fatal_error,
                        eval_ok     => $eval_ok,
                        warnings    => \@warnings,
                        where       => 'computing value',
                        long_where  => 'Computing value for null symbol: '
                          . $slg->g1_symbol_display_form($token_id),
                    }
                );
            } ## end if ( not $eval_ok or @warnings )
            return 'sig', [ 'S', $result ];
        },
        perl_rule_semantics => sub {
            my ( $irlid, $values ) = @_;
            # say Data::Dumper::Dumper($values);
            my $closure = $rule_closures->[$irlid];
            my $result;
            if ( defined $closure ) {
                my @warnings;
                my $eval_ok;
                local $SIG{__WARN__} = sub {
                    push @warnings, [ $_[0], ( caller 0 ) ];
                };
                local $Marpa::R3::Context::irlid = $irlid;
                local $Marpa::R3::Context::production_id =
                  $slg->g1_rule_to_production_id($irlid);
                $eval_ok = eval {
                    $result = $closure->( $semantics_arg0, $values );
                    1;
                };
                if ( not $eval_ok or @warnings ) {
                    my $fatal_error = $EVAL_ERROR;
                    code_problems(
                        {
                            fatal_error => $fatal_error,
                            eval_ok     => $eval_ok,
                            warnings    => \@warnings,
                            where       => 'computing value',
                            long_where  => 'Computing value for rule: '
                              . $slg->g1_rule_show($irlid),
                        }
                    );
                } ## end if ( not $eval_ok or @warnings )
            }
            return 'sig', [ 'S', $result ];
        }
    );

    my ($cmd, $final_value) =
 $slv->coro_by_tag(
        ( '@' . __FILE__ . ':' . __LINE__ ),
        {
            signature => '',
            args      => [],
            handlers  => \%value_handlers
        },
        <<'END_OF_LUA');
        local slv = ...
        return slv:value()
END_OF_LUA

    return if $cmd ne 'ok';
    return \($final_value);

}

# not to be documented
sub Marpa::R3::Valuer::call_by_tag {
    my ( $slv, $tag, $codestr, $signature, @args ) = @_;
    my $lua   = $slv->[Marpa::R3::Internal_V::L];
    my $regix = $slv->[Marpa::R3::Internal_V::REGIX];

    my @results;
    my $eval_error;
    my $eval_ok;
    {
        local $@;
        $eval_ok = eval {
            @results =
              $lua->call_by_tag( $regix, $tag, $codestr, $signature, @args );
            return 1;
        };
        $eval_error = $@;
    }
    if ( not $eval_ok ) {
        Marpa::R3::exception($eval_error);
    }
    return @results;
}

# not to be documented
sub Marpa::R3::Valuer::coro_by_tag {
    my ( $slv, $tag, $args, $codestr ) = @_;
    my $lua        = $slv->[Marpa::R3::Internal_V::L];
    my $regix      = $slv->[Marpa::R3::Internal_V::REGIX];
    my $handler    = $args->{handlers} // {};
    my $resume_tag = $tag . '[R]';
    my $signature  = $args->{signature} // '';
    my $p_args     = $args->{args} // [];

    my @results;
    my $eval_error;
    my $eval_ok;
    {
        local $@;
        $eval_ok = eval {
            $lua->call_by_tag( $regix, $tag, $codestr, $signature, @{$p_args} );
            my @resume_args = ('');
            my $signature = 's';
          CORO_CALL: while (1) {
                my ( $cmd, $yield_data ) =
                  $lua->call_by_tag( $regix, $resume_tag,
                    'local slv, resume_arg = ...; return _M.resume(resume_arg)',
                    $signature, @resume_args ) ;
                if (not $cmd) {
                   @results = @{$yield_data};
                   return 1;
                }
                my $handler = $handler->{$cmd};
                Marpa::R3::exception(qq{No coro handler for "$cmd"})
                  if not $handler;
                $yield_data //= [];
                my ($handler_cmd, $new_resume_args) = $handler->(@{$yield_data});
                Marpa::R3::exception(qq{Undefined return command from handler for "$cmd"})
                   if not defined $handler_cmd;
                if ($handler_cmd eq 'ok') {
                   $signature = 's';
                   @resume_args = ($new_resume_args);
                   if (scalar @resume_args < 1) {
                       @resume_args = ('');
                   }
                   next CORO_CALL;
                }
                if ($handler_cmd eq 'sig') {
                   @resume_args = @{$new_resume_args};
                   $signature = shift @resume_args;
                   next CORO_CALL;
                }
                Marpa::R3::exception(qq{Bad return command ("$handler_cmd") from handler for "$cmd"})
            }
            return 1;
        };
        $eval_error = $@;
    }
    if ( not $eval_ok ) {
        # if it's an object, just die
        die $eval_error if ref $eval_error;
        Marpa::R3::exception($eval_error);
    }
    return @results;
}

# not to be documented
sub Marpa::R3::Valuer::tree_show {
    my ( $slv, $verbose ) = @_;
    my $text = q{};
    NOOK: for ( my $nook_id = 0; 1; $nook_id++ ) {
        my $nook_text = $slv->nook_show( $nook_id, $verbose );
        last NOOK if not defined $nook_text;
        $text .= "$nook_id: $nook_text";
    }
    return $text;
}

# not to be documented
sub Marpa::R3::Valuer::nook_show {
    my ( $slv, $nook_id, $verbose ) = @_;
    my $slr = $slv->[Marpa::R3::Internal_V::SLR];

    my ($or_node_id, $text) = $slv->call_by_tag(
    ('@' . __FILE__ . ':' . __LINE__),
    <<'END_OF_LUA', 'i', $nook_id);
    local slv, nook_id = ...
    local slr = slv.slr
    local tree = slv.lmw_t
    -- print('nook_id', nook_id)
    local or_node_id = tree:_nook_or_node(nook_id)
    if not or_node_id then return end
    local text = 'o' .. or_node_id
    local parent = tree:_nook_parent(nook_id) or '-'
    -- print('nook_is_cause', tree:_nook_is_cause(nook_id))
    if tree:_nook_is_cause(nook_id) ~= 0 then
        text = text .. '[c' .. parent .. ']'
        goto CHILD_TYPE_FOUND
    end
    if tree:_nook_is_predecessor(nook_id) ~= 0 then
        text = text .. '[p' .. parent .. ']'
        goto CHILD_TYPE_FOUND
    end
    text = text .. '[-]'
    ::CHILD_TYPE_FOUND::

    if not or_node_id then return end

    local tree = slv.lmw_t
    text = text .. " " .. slv:or_node_tag(or_node_id) .. ' p'
    if tree:_nook_predecessor_is_ready(nook_id) ~= 0 then
        text = text .. '=ok'
    else
        text = text .. '-'
    end
    text = text .. ' c'
    if tree:_nook_cause_is_ready(nook_id) ~= 0 then
        text = text .. '=ok'
    else
        text = text .. '-'
    end
    text = text .. '\n'
    return or_node_id, text
END_OF_LUA

    return if not defined $or_node_id;

    DESCRIBE_CHOICES: {
        my $this_choice;
        ($this_choice) = $slv->call_by_tag(
    ('@' . __FILE__ . ':' . __LINE__),
            'local slv, nook_id = ...; return slv.lmw_t:_nook_choice(nook_id)',
            'i', $nook_id
        );
        CHOICE: for ( my $choice_ix = 0;; $choice_ix++ ) {

                my ($and_node_id) = $slv->call_by_tag(
    ('@' . __FILE__ . ':' . __LINE__),
                <<'END_OF_LUA', 'ii>*', $or_node_id, $choice_ix );
                local slv, or_node_id, choice_ix = ...
                return slv.lmw_o:_and_order_get(or_node_id+0, choice_ix+0)
END_OF_LUA

            last CHOICE if not defined $and_node_id;
            $text .= " o$or_node_id" . '[' . $choice_ix . ']';
            if ( defined $this_choice and $this_choice == $choice_ix ) {
                $text .= q{*};
            }
            my $and_node_tag =
                $slv->and_node_tag( $and_node_id );
            $text .= " ::= a$and_node_id $and_node_tag";
            $text .= "\n";
        } ## end CHOICE: for ( my $choice_ix = 0;; $choice_ix++ )
    } ## end DESCRIBE_CHOICES:
    return $text;
}

# not to be documented
sub Marpa::R3::Valuer::and_node_tag {
    my ( $slv, $and_node_id ) = @_;

    my ($tag) = $slv->call_by_tag( ( '@' . __FILE__ . ':' . __LINE__ ),
        << 'END_OF_LUA', 'i', $and_node_id );
    local slv, and_node_id=...
    return slv:and_node_tag(and_node_id)
END_OF_LUA

    return $tag;
}

# not to be documented
sub Marpa::R3::Valuer::verbose_or_node {
    my ( $slv, $or_node_id ) = @_;
    my $slr = $slv->[Marpa::R3::Internal_V::SLR];
    my $slg = $slr->[Marpa::R3::Internal_R::SLG];

    my ($text, $nrl_id, $position)
        = $slv->call_by_tag(
    ('@' . __FILE__ . ':' . __LINE__),
        <<'END_OF_LUA', 'i', $or_node_id);
        local slv, or_node_id = ...
        local slr = slv.slr
        local bocage = slv.lmw_b
        local origin = bocage:_or_node_origin(or_node_id)
        if not origin then return end
        local set = bocage:_or_node_set(or_node_id)
        local position = bocage:_or_node_position(or_node_id)
        local g1r = slr.g1
        local origin_earleme = g1r:earleme(origin)
        local current_earleme = g1r:earleme(set)
        local text = string.format(
            'OR-node #%d: R%d:@%d-%d\n',
            or_node_id,
            position,
            origin_earleme,
            current_earleme,
            )

END_OF_LUA
    return if not $text;

    $text .= ( q{ } x 4 )
        . $slg->dotted_nrl_show( $nrl_id, $position ) . "\n";
    return $text;
}

# not to be documented
sub Marpa::R3::Valuer::bocage_show {
    my ($slv)     = @_;

    my ($result) = $slv->call_by_tag(
    ('@' . __FILE__ . ':' . __LINE__),
        <<'END_OF_LUA', '');
        local slv = ...
        return slv:bocage_show()
END_OF_LUA

    return $result;
}

# not to be documented
sub Marpa::R3::Valuer::or_nodes_show {
    my ( $slv ) = @_;

    my ($result) = $slv->call_by_tag(
    ('@' . __FILE__ . ':' . __LINE__),
    <<'END_OF_LUA', '');
    local slv = ...
    return slv:or_nodes_show()
END_OF_LUA

    return $result;
}

# not to be documented
sub Marpa::R3::Valuer::and_nodes_show {
    my ( $slv ) = @_;
    my ($result) = $slv->call_by_tag(
    ('@' . __FILE__ . ':' . __LINE__),
    <<'END_OF_LUA', '');
    local slv = ...
    return slv:and_nodes_show()
END_OF_LUA

    return $result;
}

sub Marpa::R3::Valuer::ambiguous {
    my ($slv) = @_;
    my $slr = $slv->[Marpa::R3::Internal_V::SLR];
    my $ambiguity_level = $slv->ambiguity_level();
    return q{No parse} if $ambiguity_level <= 0;
    return q{} if $ambiguity_level == 1;
    # ASF must be created for end location of SLV (not SLR!)
    my $asf = Marpa::R3::ASF2->new( { recognizer => $slr, end => $slv->g1_pos() } );
    die 'Could not create ASF' if not defined $asf;
    my $ambiguities = Marpa::R3::Internal_ASF2::ambiguities($asf);
    my @ambiguities = grep {defined} @{$ambiguities}[ 0 .. 1 ];
    return Marpa::R3::Internal_ASF2::ambiguities_show( $asf, \@ambiguities );
} ## end sub Marpa::R3::Recognizer::ambiguous

sub Marpa::R3::Valuer::ambiguity_level {
    my ($slv) = @_;

    my ($metric) = $slv->call_by_tag(
    ('@' . __FILE__ . ':' . __LINE__),
    <<'END__OF_LUA', '>*' );
    local slv = ...
    return slv:ambiguity_level()
END__OF_LUA
    return $metric;
}

sub Marpa::R3::Valuer::g1_pos {
    my ( $slv ) = @_;
    my ($g1_pos) = $slv->call_by_tag(
    ('@' . __FILE__ . ':' . __LINE__),
    <<'END__OF_LUA', '>*' );
    local slv = ...
    return slv:g1_pos()
END__OF_LUA
    return $g1_pos;
}

# not to be documented
sub Marpa::R3::Valuer::regix {
    my ( $slv ) = @_;
    my $regix = $slv->[Marpa::R3::Internal_V::REGIX];
    return $regix;
}

1;

# vim: expandtab shiftwidth=4: