our
$VERSION
= 0.001_001;
our
%properties
= (
filehandle
=>
my
string
$TYPED_filehandle
=
undef
,
arguments
=>
my
object__array_ref
$TYPED_arguments
=
undef
,
);
our
%properties_class
= (
name
=>
my
string
$TYPED_name
=
'print'
,
parentheses_require
=>
my
integer
$TYPED_parentheses_require
= 0,
parentheses_allow
=>
my
integer
$TYPED_parentheses_allow
= 0,
arguments_min
=>
my
integer
$TYPED_arguments_min
= 1,
arguments_max
=>
my
integer
$TYPED_arguments_max
= 999,
);
our
string__method
$rperl_to_cpp__generate__CPPOPS_PERLTYPES
=
sub
{
(
my
object
$self
) =
@_
;
my
string
$self_generated
=
q{}
;
$self_generated
.=
"# STUB PERL CODE STRING, CREATED BY RPerl::Operation::Statement::OperatorVoid::Print\n"
;
return
(
$self_generated
);
};
our
string__method
$rperl_to_cpp__generate__CPPOPS_CPPTYPES
=
sub
{
(
my
object
$self
) =
@_
;
my
string
$self_generated
=
q{}
;
$self_generated
.=
q{ }
x 4;
if
(
defined
$self
->{filehandle} ) {
if
(
$self
->{filehandle} eq
q{*STDERR}
) {
$self_generated
.=
'cerr'
;
}
else
{
croak(
"\nERROR ECVGESY00, C++ GENERATOR, RPERL SYNTAX:\nin OperatorVoid '"
.
$self
->{name}
.
q{', expected '*STDERR' or no filehandle, but non-matching filehandle '}
.
$self
->{filehandle}
.
"' found,\ncroaking"
);
}
}
else
{
$self_generated
.=
'cout'
;
}
foreach
my
object
$argument
( @{
$self
->{arguments}->{elements} } ) {
$self_generated
.=
' <<'
;
my
string
$argument_class
= blessed(
$argument
);
if
( (
$argument_class
eq
'RPerl::Operation::Expression::Literal'
)
or
(
$argument_class
eq
'RPerl::Operation::Expression::Variable'
) )
{
$self_generated
.=
q{ }
.
$argument
->rperl_to_cpp__generate__CPPOPS_CPPTYPES();
}
else
{
croak(
"\nERROR ECVGESY02, C++ GENERATOR, RPERL SYNTAX:\nin OperatorVoid '"
.
$self
->{name}
.
q{', expected Literal or Variable argument, but non-matching argument class '}
.
$argument_class
.
"' found,\ncroaking"
);
}
}
$self_generated
.=
";\n"
;
return
(
$self_generated
);
};
our
object__method
$ppi_to_rperl__translate
=
sub
{
(
my
string
$class
,
my
object
$node
) =
@_
;
my
string
$rule_name
=
'OPERATOR_VOID'
;
my
string
$production_name
=
'PRINT'
;
my
string
$component_name
;
my
string
$node_class
;
my
string
$node_class_expected
=
'PPI::Statement'
;
my
object
$node_translated
;
my
object
$child
;
my
string
$child_key
;
my
integer
$child_index
;
my
integer
$child_index_max
;
my
string
$child_class
;
my
string
$child_class_expected
;
my
string
$child_content
;
my
string
$child_content_expected
;
my
integer
$child_disqualified
;
my
object
$grandchild
;
my
string
$grandchild_key
;
my
integer
$grandchild_index
;
my
integer
$grandchild_index_max
;
my
string
$grandchild_class
;
my
string
$grandchild_class_expected
;
my
string
$grandchild_content
;
my
string
$grandchild_content_expected
;
my
integer
$grandchild_disqualified
;
my
object
$greatgrandchild
;
my
string
$greatgrandchild_key
;
my
integer
$greatgrandchild_index
;
my
string
$greatgrandchild_class
;
my
string
$greatgrandchild_class_expected
;
RPerl::diag
"in Print::ppi_to_rperl__translate(), received \$node =\n"
. Dumper(
$node
) .
"\n"
;
if
( not(
defined
$node
) ) {
croak(
"\nERROR ECVTRPI00, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, PPI OBJECT FAILURE:\nobject expected but undefined/null value found,\ncroaking"
);
}
$node_class
= blessed(
$node
);
if
( not(
defined
$node_class
) ) {
croak(
"\nERROR ECVTRPI01, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, PPI OBJECT FAILURE:\nobject expected but non-object value found,\ncroaking"
);
}
RPerl::diag
"in Print::ppi_to_rperl__translate(), have \$node_class = '$node_class'\n"
;
if
(
$node_class
ne
$node_class_expected
) {
croak(
"\nERROR ECVTRPI02, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, PPI OBJECT FAILURE:\n$node_class_expected object expected but $node_class object found,\ncroaking"
);
}
$child_key
=
'children'
;
if
( not(
defined
$node
->{
$child_key
} ) ) {
croak(
"\nERROR ECVTRPI03, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, PPI OBJECT FAILURE:\nchildren sub-objects array_ref value expected but undefined/null value found,\ncroaking"
);
}
$child_index_max
= (
scalar
@{
$node
->{
$child_key
} } ) - 1;
if
(
$child_index_max
< 0 ) {
croak(
"\nERROR ECVTRPI04, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, PPI OBJECT FAILURE:\nmultiple children sub-objects expected but none found,\ncroaking"
);
}
$component_name
=
'_OPERATOR_VOID_NAME'
;
$child_key
=
'children'
;
$child_index
= 0;
$child_class_expected
=
'PPI::Token::Word'
;
$child_content_expected
= ( \
%properties_class
)->{name};
$child
=
$node
->{
$child_key
}->[
$child_index
];
if
( not(
defined
$child
) ) {
croak(
"\nERROR ECVTRPI05, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, PPI OBJECT FAILURE:\nin $node_class object, $child_class_expected child sub-object expected at key '$child_key' and index $child_index but undefined/null value found,\ncroaking"
);
}
$child_class
= blessed(
$child
);
if
( not(
defined
$child_class
) ) {
croak(
"\nERROR ECVTRPI06, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, PPI OBJECT FAILURE:\nin $node_class object, $child_class_expected child sub-object expected at key '$child_key' and index $child_index but non-object value found,\ncroaking"
);
}
if
(
$child_class
ne
$child_class_expected
) {
croak(
"\nERROR ECVTRSY00, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, RPERL SYNTAX:\nin $node_class object, $child_class_expected child sub-object expected at key '$child_key' and index $child_index,\nbut $child_class great-grandchild sub-sub-sub-object found,\ncroaking"
);
}
$child_content
=
$child
->{content};
if
(
$child_content
ne
$child_content_expected
) {
croak(
"\nERROR ECVTRSY01, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, RPERL SYNTAX:\nin $node_class object, in $child_class child sub-object at index $child_index, '$child_content_expected' expected but '$child_content' found,\ncroaking"
);
}
$node_translated
= RPerl::Operation::Statement::OperatorVoid::Print->new();
$component_name
=
'POSSIBLE ARGUMENT__FILEHANDLE'
;
$child_key
=
'children'
;
$child_index
= 1;
$child_class_expected
=
'PPI::Structure::Block'
;
$child_disqualified
= 0;
$grandchild_key
=
'children'
;
$grandchild_index
= 0;
$grandchild_class_expected
=
'PPI::Statement'
;
$greatgrandchild_key
=
'children'
;
$greatgrandchild_index
= 0;
$greatgrandchild_class_expected
=
'PPI::Token::Symbol'
;
$child
=
$node
->{
$child_key
}->[
$child_index
];
if
( not(
defined
$child
) ) {
croak(
"\nERROR ECVTRPI05, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, PPI OBJECT FAILURE:\nin $node_class object, $child_class_expected child sub-object expected at key '$child_key' and index $child_index but undefined/null value found,\ncroaking"
);
}
$child_class
= blessed(
$child
);
if
( not(
defined
$child_class
) ) {
croak(
"\nERROR ECVTRPI06, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, PPI OBJECT FAILURE:\nin $node_class object, $child_class_expected child sub-object expected at key '$child_key' and index $child_index but non-object value found,\ncroaking"
);
}
if
(
$child_class
ne
$child_class_expected
) {
$child_disqualified
= 1;
}
if
( not
$child_disqualified
) {
$grandchild
=
$node
->{
$child_key
}->[
$child_index
]->{
$grandchild_key
}
->[
$grandchild_index
];
if
( not(
defined
$grandchild
) ) {
croak(
"\nERROR ECVTRPI05, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, PPI OBJECT FAILURE:\nin $node_class object, $grandchild_class_expected grandchild sub-sub-object expected at key '$grandchild_key' and index $grandchild_index but undefined/null value found,\ncroaking"
);
}
$grandchild_class
= blessed(
$grandchild
);
if
( not(
defined
$grandchild_class
) ) {
croak(
"\nERROR ECVTRPI06, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, PPI OBJECT FAILURE:\nin $node_class object, $grandchild_class_expected grandchild sub-sub-object expected at key '$grandchild_key' and index $grandchild_index but non-object value found,\ncroaking"
);
}
if
(
$grandchild_class
ne
$grandchild_class_expected
) {
croak(
"\nERROR ECVTRSY00, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, RPERL SYNTAX:\nin $node_class object, $grandchild_class_expected grandchild sub-sub-object expected at key '$grandchild_key' and index $grandchild_index,\nbut $grandchild_class grandchild sub-sub-object found,\ncroaking"
);
}
$greatgrandchild
=
$node
->{
$child_key
}->[
$child_index
]->{
$grandchild_key
}
->[
$grandchild_index
]->{
$greatgrandchild_key
}
->[
$greatgrandchild_index
];
if
( not(
defined
$greatgrandchild
) ) {
croak(
"\nERROR ECVTRPI05, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, PPI OBJECT FAILURE:\nin $node_class object, $greatgrandchild_class_expected great-grandchild sub-sub-sub-object expected at key '$greatgrandchild_key' and index $greatgrandchild_index but undefined/null value found,\ncroaking"
);
}
$greatgrandchild_class
= blessed(
$greatgrandchild
);
if
( not(
defined
$greatgrandchild_class
) ) {
croak(
"\nERROR ECVTRPI06, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, PPI OBJECT FAILURE:\nin $node_class object, $greatgrandchild_class_expected great-grandchild sub-sub-sub-object expected at key '$greatgrandchild_key' and index $greatgrandchild_index but non-object value found,\ncroaking"
);
}
if
(
$greatgrandchild_class
ne
$greatgrandchild_class_expected
) {
croak(
"\nERROR ECVTRSY00, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, RPERL SYNTAX:\nin $node_class object, $greatgrandchild_class_expected great-grandchild sub-sub-sub-object expected at key '$greatgrandchild_key' and index $greatgrandchild_index,\nbut $greatgrandchild_class great-grandchild sub-sub-sub-object found,\ncroaking"
);
}
$node_translated
->{filehandle} =
$greatgrandchild
->{content};
$child_index
++;
}
$component_name
=
'LIST_ELEMENTS'
;
my
integer
$arguments_count
=
$child_index_max
-
$child_index
;
if
(
$arguments_count
< ( \
%properties_class
)->{arguments_min} ) {
croak(
"\nERROR ECVTRSY02, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, RPERL SYNTAX:\nin $node_class object, '"
. ( \
%properties_class
)->{name}
.
q{' operator, }
. ( \
%properties_class
)->{arguments_min}
.
" minimum argument(s) expected, but $arguments_count argument(s) found,\ncroaking"
);
}
if
(
$arguments_count
> ( \
%properties_class
)->{arguments_max} ) {
croak(
"\nERROR ECVTRSY03, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, RPERL SYNTAX:\nin $node_class object, '"
. ( \
%properties_class
)->{name}
.
q{' operator, }
. ( \
%properties_class
)->{arguments_min}
.
" maximum argument(s) expected, but $arguments_count argument(s) found,\ncroaking"
);
}
my
@arguments_array
= @{
$node
->{
$child_key
} }
[
$child_index
.. (
$child_index_max
- 1 ) ];
my
object__array_ref
$arguments
= \
@arguments_array
;
my
object
$arguments_node
= PPI::Statement->new();
$arguments_node
->{children} =
$arguments
;
$node_translated
->{arguments}
= RPerl::DataStructure::Array::ListElements->ppi_to_rperl__translate(
$arguments_node
);
$component_name
=
'SEMICOLON'
;
$child_key
=
'children'
;
$child_index
=
$child_index_max
;
$child_class_expected
=
'PPI::Token::Structure'
;
$child_content_expected
=
q{;}
;
$child
=
$node
->{
$child_key
}->[
$child_index
];
if
( not(
defined
$child
) ) {
croak(
"\nERROR ECVTRPI05, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, PPI OBJECT FAILURE:\nin $node_class object, $child_class_expected child sub-object expected at index $child_index but undefined/null value found,\ncroaking"
);
}
$child_class
= blessed(
$child
);
if
( not(
defined
$child_class
) ) {
croak(
"\nERROR ECVTRPI06, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, PPI OBJECT FAILURE:\nin $node_class object, $child_class_expected child sub-object expected at index $child_index but non-object value found,\ncroaking"
);
}
if
(
$child_class
ne
$child_class_expected
) {
croak(
"\nERROR ECVTRSY00, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, RPERL SYNTAX:\nin $node_class object, $child_class_expected child sub-object expected at index $child_index but $child_class child sub-object found,\ncroaking"
);
}
$child_content
=
$child
->{content};
if
(
$child_content
ne
$child_content_expected
) {
croak(
"\nERROR ECVTRSY01, PPI DOCTREE TO RPERL AST TRANSLATOR, $rule_name RULE, $production_name PRODUCTION, $component_name COMPONENT, RPERL SYNTAX:\nin $node_class object, in $child_class child sub-object at index $child_index, '$child_content_expected' expected but '$child_content' found,\ncroaking"
);
}
RPerl::diag
"in Print::ppi_to_rperl__translate(), bottom of subroutine, about to return \$node_translated=\n"
. Dumper(
$node_translated
) .
"\n"
;
return
(
$node_translated
);
};
1;