From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

# [[[ DOCUMENTATION ]]]
# SUPPORTED: keys HASH
# UNSUPPORTED: keys ARRAY
# [[[ HEADER ]]]
use strict;
our $VERSION = 0.002_000;
# [[[ OO INHERITANCE ]]]
# [[[ CRITICS ]]]
## no critic qw(ProhibitUselessNoCritic ProhibitMagicNumbers RequireCheckedSyscalls) # USER DEFAULT 1: allow numeric values & print operator
## no critic qw(RequireInterpolationOfMetachars) # USER DEFAULT 2: allow single-quoted control characters & sigils
## no critic qw(ProhibitConstantPragma ProhibitMagicNumbers) # USER DEFAULT 3: allow constants
# [[[ CONSTANTS ]]]
use constant NAME => my string $TYPED_NAME = 'keys';
use constant NAME_CPPOPS_PERLTYPES => my string $TYPED_NAME_CPPOPS_PERLTYPES = 'DUMMY_OP_SCALAR';
use constant NAME_CPPOPS_CPPTYPES => my string $TYPED_NAME_CPPOPS_CPPTYPES = 'keys';
use constant ARGUMENTS_MIN => my integer $TYPED_ARGUMENTS_MIN = 1;
use constant ARGUMENTS_MAX => my integer $TYPED_ARGUMENTS_MAX = 1;
# [[[ OO PROPERTIES ]]]
our hashref $properties = {};
# [[[ SUBROUTINES & OO METHODS ]]]
sub ast_to_rperl__generate {
{ my string_hashref::method $RETURN_TYPE };
( my object $self, my object $operator_named, my string_hashref $modes) = @ARG;
my string_hashref $rperl_source_group = { PMC => q{} };
# RPerl::diag( 'in Operator::Named::Keys->ast_to_rperl__generate(), received $self = ' . "\n" . RPerl::Parser::rperl_ast__dump($self) . "\n" );
# RPerl::diag( 'in Operator::Named::Keys->ast_to_rperl__generate(), received $operator_named = ' . "\n" . RPerl::Parser::rperl_ast__dump($operator_named) . "\n" );
my string $operator_named_class = ref $operator_named;
if ( $operator_named_class eq 'Operation_96' ) { # Operation -> OP01_NAMED_SCOLON
die RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASRP016, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Named operator '
. $operator_named->{children}->[0] . ' requires exactly one argument, dying' ) . "\n";
}
elsif ( $operator_named_class eq 'Operator_100' ) { # Operator -> OP01_NAMED SubExpression
$rperl_source_group->{PMC} .= $operator_named->{children}->[0] . q{ };
my string_hashref $rperl_source_subgroup = $operator_named->{children}->[1]->ast_to_rperl__generate( $modes, $self );
RPerl::Generator::source_group_append( $rperl_source_group, $rperl_source_subgroup );
}
elsif ( $operator_named_class eq 'Operator_101' ) { # Operator -> LPAREN OP01_NAMED ListElement OP21_LIST_COMMA ListElements ')'
die RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASRP014, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Named operator '
. $operator_named->{children}->[1] . ' does not accept multiple arguments, dying' ) . "\n";
}
elsif ( $operator_named_class eq 'OperatorVoid_140' ) { # OperatorVoid -> OP01_NAMED ListElement OP21_LIST_COMMA ListElements ';'
die RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASRP014, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Named operator '
. $operator_named->{children}->[0] . ' does not accept multiple arguments, dying' ) . "\n";
}
else {
die RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASRP000, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Grammar rule '
. ($operator_named_class) . ' found where Operation_96, Operator_100, Operator_101, or OperatorVoid_140 expected, dying' ) . "\n";
}
return $rperl_source_group;
}
sub ast_to_cpp__generate__CPPOPS_PERLTYPES {
{ my string_hashref::method $RETURN_TYPE };
( my object $self, my string_hashref $modes) = @ARG;
my string_hashref $cpp_source_group
= { CPP => q{// <<< RP::O::E::O::N::K __DUMMY_SOURCE_CODE CPPOPS_PERLTYPES >>>} . "\n" };
#...
return $cpp_source_group;
}
sub ast_to_cpp__generate__CPPOPS_CPPTYPES {
{ my string_hashref::method $RETURN_TYPE };
( my object $self, my object $operator_named, my string_hashref $modes) = @ARG;
my string_hashref $cpp_source_group
= { CPP => q{} };
# RPerl::diag( 'in Operator::Named::Keys->ast_to_cpp__generate__CPPOPS_CPPTYPES(), received $self = ' . "\n" . RPerl::Parser::rperl_ast__dump($self) . "\n" );
# RPerl::diag( 'in Operator::Named::Keys->ast_to_cpp__generate__CPPOPS_CPPTYPES(), received $operator_named = ' . "\n" . RPerl::Parser::rperl_ast__dump($operator_named) . "\n" );
my string $operator_named_class = ref $operator_named;
if ( $operator_named_class eq 'Operation_96' ) { # Operation -> OP01_NAMED_SCOLON
die RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP016, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Named operator '
. $operator_named->{children}->[0] . ' requires exactly one argument, dying' ) . "\n";
}
elsif ( $operator_named_class eq 'Operator_100' ) { # Operator -> OP01_NAMED SubExpression
# START HERE: need handle PERLOPS_PERLTYPES 'keys' retval being hash not hashref???
# START HERE: need handle PERLOPS_PERLTYPES 'keys' retval being hash not hashref???
# START HERE: need handle PERLOPS_PERLTYPES 'keys' retval being hash not hashref???
# RPerl::diag( 'in Operator::Named::Keys->ast_to_cpp__generate__CPPOPS_CPPTYPES(), have $operator_named->{children}->[1] = ' . "\n" . RPerl::Parser::rperl_ast__dump($operator_named->{children}->[1]) . "\n" );
# DEV NOTE, CORRELATION #rp031: NEED UPGRADE: implement proper @array vs $arrayref, %hash vs $hashref, dereferencing, etc.
# UPGRADE START HERE: do not require named operator or HashDereference below, once we allow RPerl variables/subroutines to store/return non-reference %hashes; sync w/ PERLOPS_PERLTYPES above; create tests
# UPGRADE START HERE: do not require named operator or HashDereference below, once we allow RPerl variables/subroutines to store/return non-reference %hashes; sync w/ PERLOPS_PERLTYPES above; create tests
# UPGRADE START HERE: do not require named operator or HashDereference below, once we allow RPerl variables/subroutines to store/return non-reference %hashes; sync w/ PERLOPS_PERLTYPES above; create tests
# must have Perl named operator (AKA named function) or HashDereference as only argument, because this operator requires non-reference hash input
my object $subexpression = $operator_named->{children}->[1];
my string $subexpression_class = ref $subexpression;
if ( (not exists $rperloperations::BUILTINS_PERL_NAMED->{$subexpression_class})
and ( $subexpression_class ne 'SubExpression_162' )
and ( $subexpression_class ne 'HashDereference_236' )
and ( $subexpression_class ne 'HashDereference_237' ) )
{
die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASCP870, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Named operator ' . q{'} . $operator_named->{children}->[0] . q{'}
. ' requires Perl named operator (AKA named function) or HashDereference argument, received ' . $subexpression_class . ' instead, dying' ) . "\n";
}
# unwrap HashDereference_236 and HashDereference_237 from SubExpression_162
if ( $subexpression_class eq 'SubExpression_162' ) { # SubExpression -> HashDereference
$subexpression = $subexpression->{children}->[0];
}
$subexpression_class = ref $subexpression;
my string_hashref $cpp_source_subgroup;
# this operator is implemented as a C++ function, must wrap operands in parentheses
$cpp_source_group->{CPP} .= NAME_CPPOPS_CPPTYPES() . '(';
# NEED REMOVE OR MODIFY DURING UPGRADE
if ( exists $rperloperations::BUILTINS_PERL_NAMED->{$subexpression_class} ) {
die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASCP8xx, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Named operator ' . q{'} . $operator_named->{children}->[0] . q{'}
. ' received Perl named operator (AKA named function) argument ' . $subexpression_class . '; this feature is not yet supported, dying' ) . "\n";
}
# DEV NOTE, CORRELATION #rp031: NEED UPGRADE: implement proper @array vs $arrayref, %hash vs $hashref, dereferencing, etc.
# UPGRADE START HERE: do not unwrap and disregard HashDereference @{...} operator below, must actually perform dereference by unwrapping std::vector from std::unique_ptr<std::vector>
# UPGRADE START HERE: do not unwrap and disregard HashDereference @{...} operator below, must actually perform dereference by unwrapping std::vector from std::unique_ptr<std::vector>
# UPGRADE START HERE: do not unwrap and disregard HashDereference @{...} operator below, must actually perform dereference by unwrapping std::vector from std::unique_ptr<std::vector>
elsif ( $subexpression_class eq 'HashDereference_236' ) { # HashDereference -> '@{' Variable '}'
$cpp_source_subgroup = $subexpression->{children}->[1]->ast_to_cpp__generate__CPPOPS_CPPTYPES($modes);
RPerl::Generator::source_group_append( $cpp_source_group, $cpp_source_subgroup );
}
elsif ( $subexpression_class eq 'HashDereference_237' ) { # HashDereference -> '@{' TypeInner? HashReference '}'
my object $type_inner_optional = $subexpression->{children}->[1];
my object $hash_reference = $subexpression->{children}->[2];
# DEV NOTE: in CPPOPS_CPPTYPES, must cast hashref data to proper type as provided by TypeInner
if ( exists $type_inner_optional->{children}->[0] ) {
$cpp_source_group->{CPP} .= '((';
$cpp_source_subgroup = $type_inner_optional->{children}->[0]->ast_to_cpp__generate__CPPOPS_CPPTYPES($modes);
# RPerl::diag( 'in NamedUnary::Scalar->ast_to_cpp__generate__CPPOPS_CPPTYPES(), have $cpp_source_subgroup = ' . "\n" . RPerl::Parser::rperl_ast__dump($cpp_source_subgroup) . "\n" );
RPerl::Generator::source_group_append( $cpp_source_group, $cpp_source_subgroup );
$cpp_source_group->{CPP} .= ') ';
$cpp_source_subgroup = $hash_reference->ast_to_cpp__generate__CPPOPS_CPPTYPES($modes);
RPerl::Generator::source_group_append( $cpp_source_group, $cpp_source_subgroup );
$cpp_source_group->{CPP} .= ')';
}
else {
die RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP872, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Hash dereference of hash reference must provide data type for hash reference in CPPOPS_CPPTYPES mode, but no data type provided, dying'
) . "\n";
}
}
else {
die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASCP000, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Grammar rule '
. $subexpression_class
. ' found where HashDereference_236 or HashDereference_237 expected, dying' )
. "\n";
}
$cpp_source_group->{CPP} .= ')';
}
elsif ( $operator_named_class eq 'Operator_101' ) { # Operator -> LPAREN OP01_NAMED ListElement OP21_LIST_COMMA ListElements ')'
die RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP014, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Named operator '
. $operator_named->{children}->[1] . ' does not accept multiple arguments, dying' ) . "\n";
}
elsif ( $operator_named_class eq 'OperatorVoid_140' ) { # OperatorVoid -> OP01_NAMED ListElement OP21_LIST_COMMA ListElements ';'
die RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP014, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Named operator '
. $operator_named->{children}->[0] . ' does not accept multiple arguments, dying' ) . "\n";
}
else {
die RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP000, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Grammar rule '
. ($operator_named_class) . ' found where Operation_96, Operator_100, Operator_101, or OperatorVoid_140 expected, dying' ) . "\n";
}
return $cpp_source_group;
}
1; # end of class