use
5.010001;
use
vars
qw($VERSION $STRING_VERSION)
;
$VERSION
=
'4.001_051'
;
$STRING_VERSION
=
$VERSION
;
$VERSION
=
eval
$VERSION
;
our
$PACKAGE
=
'Marpa::R3::Valuer'
;
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 {
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
;
}
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
;
}
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"
;
}
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"
;
}
$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"}
;
}
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
;
}
$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
;
}
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
;
}
Marpa::R3::exception(
@msg
);
return
1;
}
sub
Marpa::R3::Valuer::new {
my
(
$class
,
@args
) =
@_
;
my
$slv
= [];
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 {
my
$slv
=
shift
;
my
$lua
=
$slv
->[Marpa::R3::Internal_V::L];
return
if
not
$lua
;
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
;
}
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}
);
}
$blessing
=
$lexeme_name
;
$blessing
=~ s/[ ]/_/gxms;
last
FIND_BASE_BLESSING;
}
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}
);
}
}
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}
);
}
$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;
};
}
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
),
}
);
}
return
'sig'
, [
'S'
,
$result
];
},
perl_rule_semantics
=>
sub
{
my
(
$irlid
,
$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
),
}
);
}
}
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
);
}
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
;
}
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
) {
die
$eval_error
if
ref
$eval_error
;
Marpa::R3::exception(
$eval_error
);
}
return
@results
;
}
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
;
}
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"
;
}
}
return
$text
;
}
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
;
}
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
;
}
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
;
}
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
;
}
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;
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
);
}
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
;
}
sub
Marpa::R3::Valuer::regix {
my
(
$slv
) =
@_
;
my
$regix
=
$slv
->[Marpa::R3::Internal_V::REGIX];
return
$regix
;
}
1;