"Fossies" - the Fresh Open Source Software Archive

Member "RPerl-5.002000/lib/RPerl/Operation/Expression/Operator/NamedUnary/Scalar.pm" (28 Nov 2019, 11050 Bytes) of package /linux/misc/RPerl-5.002000.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Scalar.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 5.000000_vs_5.002000.

    1 # [[[ DOCUMENTATION ]]]
    2 # http://perldoc.perl.org/functions/scalar.html
    3 #     SUPPORTED:  scalar EXPR
    4 
    5 # [[[ HEADER ]]]
    6 package RPerl::Operation::Expression::Operator::NamedUnary::Scalar;
    7 use strict;
    8 use warnings;
    9 use RPerl::AfterSubclass;
   10 our $VERSION = 0.003_100;
   11 
   12 # [[[ OO INHERITANCE ]]]
   13 use parent qw(RPerl::Operation::Expression::Operator::NamedUnary);
   14 use RPerl::Operation::Expression::Operator::NamedUnary;
   15 
   16 # [[[ CRITICS ]]]
   17 ## no critic qw(ProhibitUselessNoCritic ProhibitMagicNumbers RequireCheckedSyscalls)  # USER DEFAULT 1: allow numeric values & print operator
   18 ## no critic qw(RequireInterpolationOfMetachars)  # USER DEFAULT 2: allow single-quoted control characters & sigils
   19 
   20 # [[[ CONSTANTS ]]]
   21 use constant NAME                  => my string  $TYPED_NAME                  = 'scalar';
   22 use constant NAME_CPPOPS_PERLTYPES => my string  $TYPED_NAME_CPPOPS_PERLTYPES = 'DUMMY_OP_SCALAR';
   23 use constant NAME_CPPOPS_CPPTYPES  => my string  $TYPED_NAME_CPPOPS_CPPTYPES  = 'size';
   24 use constant ARGUMENTS_MIN         => my integer $TYPED_ARGUMENTS_MIN         = 1;
   25 use constant ARGUMENTS_MAX         => my integer $TYPED_ARGUMENTS_MAX         = 1;
   26 
   27 # [[[ OO PROPERTIES ]]]
   28 our hashref $properties = {};
   29 
   30 # [[[ SUBROUTINES & OO METHODS ]]]
   31 
   32 sub ast_to_rperl__generate {
   33     { my string_hashref::method $RETURN_TYPE };
   34     ( my object $self, my object $operator_named, my string_hashref $modes) = @ARG;
   35     my string_hashref $rperl_source_group = { PMC => q{} };
   36 
   37 #    RPerl::diag( 'in Operator::NamedUnary::Scalar->ast_to_rperl__generate(), received $self = ' . "\n" . RPerl::Parser::rperl_ast__dump($self) . "\n" );
   38 #    RPerl::diag( 'in Operator::NamedUnary::Scalar->ast_to_rperl__generate(), received $operator_named = ' . "\n" . RPerl::Parser::rperl_ast__dump($operator_named) . "\n" );
   39 
   40     my string $operator_named_class = ref $operator_named;
   41     if ( $operator_named_class eq 'Operation_97' ) {    # Operation -> OP10_NAMED_UNARY_SCOLON
   42         die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASRP016, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Named operator '
   43                 . q{'} . $operator_named->{children}->[0] . q{'}
   44                 . ' requires exactly one argument, dying' )
   45             . "\n";
   46     }
   47     elsif ( $operator_named_class eq 'Operator_116' ) {    # Operator -> OP10_NAMED_UNARY SubExpression
   48         $rperl_source_group->{PMC} .= $operator_named->{children}->[0] . q{ };
   49         my string_hashref $rperl_source_subgroup = $operator_named->{children}->[1]->ast_to_rperl__generate( $modes, $self );
   50         RPerl::Generator::source_group_append( $rperl_source_group, $rperl_source_subgroup );
   51     }
   52     elsif ( $operator_named_class eq 'Operator_117' ) {    # Operator -> OP10_NAMED_UNARY
   53         die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASRP016, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Named operator '
   54                 . q{'} . $operator_named->{children}->[0] . q{'}
   55                 . ' requires exactly one argument, dying' )
   56             . "\n";
   57     }
   58     else {
   59         die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASRP000, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Grammar rule '
   60                 . ($operator_named_class)
   61                 . ' found where Operation_97, Operator_116, or Operator_117 expected, dying' )
   62             . "\n";
   63     }
   64     return $rperl_source_group;
   65 }
   66 
   67 sub ast_to_cpp__generate__CPPOPS_PERLTYPES {
   68     { my string_hashref::method $RETURN_TYPE };
   69     ( my object $self, my string_hashref $modes) = @ARG;
   70     my string_hashref $cpp_source_group = { CPP => q{// <<< RP::O::E::O::NU::Sca __DUMMY_SOURCE_CODE CPPOPS_PERLTYPES >>>} . "\n" };
   71 
   72     #...
   73     return $cpp_source_group;
   74 }
   75 
   76 sub ast_to_cpp__generate__CPPOPS_CPPTYPES {
   77     { my string_hashref::method $RETURN_TYPE };
   78     ( my object $self, my object $operator_named, my string_hashref $modes) = @ARG;
   79     my string_hashref $cpp_source_group = { CPP => q{} };
   80 
   81 #    RPerl::diag( 'in NamedUnary::Scalar->ast_to_cpp__generate__CPPOPS_CPPTYPES(), received $self = ' . "\n" . RPerl::Parser::rperl_ast__dump($self) . "\n" );
   82 #    RPerl::diag( 'in NamedUnary::Scalar->ast_to_cpp__generate__CPPOPS_CPPTYPES(), received $operator_named = ' . "\n" . RPerl::Parser::rperl_ast__dump($operator_named) . "\n" );
   83 
   84     my string $operator_named_class = ref $operator_named;
   85     if ( $operator_named_class eq 'Operation_97' ) {    # Operation -> OP10_NAMED_UNARY_SCOLON
   86         die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASCP016, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Named operator '
   87                 . q{'} . $operator_named->{children}->[0] . q{'}
   88                 . ' requires exactly one argument, dying' )
   89             . "\n";
   90     }
   91     elsif ( $operator_named_class eq 'Operator_116' ) {    # Operator -> OP10_NAMED_UNARY SubExpression
   92 
   93 
   94 
   95 
   96         # DEV NOTE, CORRELATION #rp031: NEED UPGRADE: implement proper @array vs $arrayref, %hash vs $hashref, dereferencing, etc.
   97 
   98 # UPGRADE START HERE: do not require named operator or ArrayDereference below, once we allow RPerl variables/subroutines to store/return non-reference @arrays; sync w/ PERLOPS_PERLTYPES above; create tests
   99 # UPGRADE START HERE: do not require named operator or ArrayDereference below, once we allow RPerl variables/subroutines to store/return non-reference @arrays; sync w/ PERLOPS_PERLTYPES above; create tests
  100 # UPGRADE START HERE: do not require named operator or ArrayDereference below, once we allow RPerl variables/subroutines to store/return non-reference @arrays; sync w/ PERLOPS_PERLTYPES above; create tests
  101         
  102         # must have Perl named operator (AKA named function) or ArrayDereference as only argument, because this operator requires non-reference array input
  103         my object $subexpression       = $operator_named->{children}->[1];
  104         my string $subexpression_class = ref $subexpression;
  105         if (    (not exists $rperloperations::BUILTINS_PERL_NAMED->{$subexpression_class})
  106             and ( $subexpression_class ne 'SubExpression_160' )
  107             and ( $subexpression_class ne 'ArrayDereference_221' )
  108             and ( $subexpression_class ne 'ArrayDereference_222' ) )
  109         {
  110             die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASCP870, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Named operator ' . q{'} . $operator_named->{children}->[0] . q{'}
  111                 . ' requires Perl named operator (AKA named function) or ArrayDereference argument, received ' . $subexpression_class . ' instead, dying' ) . "\n";
  112         }
  113 
  114 
  115 
  116 
  117 
  118         # unwrap ArrayDereference_221 and ArrayDereference_222 from SubExpression_160
  119         if ( $subexpression_class eq 'SubExpression_160' ) {    # SubExpression -> ArrayDereference
  120             $subexpression = $subexpression->{children}->[0];
  121         }
  122 
  123         $subexpression_class = ref $subexpression;
  124         my string_hashref $cpp_source_subgroup;
  125 
  126 
  127 
  128         # NEED REMOVE OR MODIFY DURING UPGRADE
  129         if ( exists $rperloperations::BUILTINS_PERL_NAMED->{$subexpression_class} ) {
  130             die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASCP8xx, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Named operator ' . q{'} . $operator_named->{children}->[0] . q{'}
  131                 . ' received Perl named operator (AKA named function) argument ' . $subexpression_class . '; this feature is not yet supported, dying' ) . "\n";
  132         }
  133 
  134 
  135 
  136         # DEV NOTE, CORRELATION #rp031: NEED UPGRADE: implement proper @array vs $arrayref, %hash vs $hashref, dereferencing, etc.
  137 
  138 # UPGRADE START HERE: do not unwrap and disregard ArrayDereference @{...} operator below, must actually perform dereference by unwrapping std::vector from std::unique_ptr<std::vector>
  139 # UPGRADE START HERE: do not unwrap and disregard ArrayDereference @{...} operator below, must actually perform dereference by unwrapping std::vector from std::unique_ptr<std::vector>
  140 # UPGRADE START HERE: do not unwrap and disregard ArrayDereference @{...} operator below, must actually perform dereference by unwrapping std::vector from std::unique_ptr<std::vector>
  141 
  142         elsif ( $subexpression_class eq 'ArrayDereference_221' ) {    # ArrayDereference -> '@{' Variable '}'
  143             $cpp_source_subgroup = $subexpression->{children}->[1]->ast_to_cpp__generate__CPPOPS_CPPTYPES($modes);
  144             RPerl::Generator::source_group_append( $cpp_source_group, $cpp_source_subgroup );
  145         }
  146         elsif ( $subexpression_class eq 'ArrayDereference_222' ) {    # ArrayDereference -> '@{' TypeInner? ArrayReference '}'
  147             my object $type_inner_optional = $subexpression->{children}->[1];
  148             my object $array_reference     = $subexpression->{children}->[2];
  149 
  150             # DEV NOTE: in CPPOPS_CPPTYPES, must cast arrayref data to proper type as provided by TypeInner 
  151             if ( exists $type_inner_optional->{children}->[0] ) {
  152                 $cpp_source_group->{CPP} .= '((';
  153                 $cpp_source_subgroup = $type_inner_optional->{children}->[0]->ast_to_cpp__generate__CPPOPS_CPPTYPES($modes);
  154 
  155 #                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" );
  156                 RPerl::Generator::source_group_append( $cpp_source_group, $cpp_source_subgroup );
  157                 $cpp_source_group->{CPP} .= ') ';
  158                 $cpp_source_subgroup = $array_reference->ast_to_cpp__generate__CPPOPS_CPPTYPES($modes);
  159                 RPerl::Generator::source_group_append( $cpp_source_group, $cpp_source_subgroup );
  160                 $cpp_source_group->{CPP} .= ')';
  161             }
  162             else {
  163                 die RPerl::Parser::rperl_rule__replace(
  164                     'ERROR ECOGEASCP871, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Array dereference of array reference must provide data type for array reference in CPPOPS_CPPTYPES mode, but no data type provided, dying'
  165                 ) . "\n";
  166             }
  167         }
  168         else {
  169             die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASCP000, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Grammar rule '
  170                     . $subexpression_class
  171                     . ' found where ArrayDereference_221 or ArrayDereference_222 expected, dying' )
  172                 . "\n";
  173         }
  174 
  175         $cpp_source_group->{CPP} .= '.' . NAME_CPPOPS_CPPTYPES() . '()';
  176     }
  177     elsif ( $operator_named_class eq 'Operator_117' ) {    # Operator -> OP10_NAMED_UNARY
  178         die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASCP016, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Named operator '
  179                 . $operator_named->{children}->[0]
  180                 . ' requires exactly one argument, dying' )
  181             . "\n";
  182     }
  183     else {
  184         die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASCP000, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Grammar rule '
  185                 . ($operator_named_class)
  186                 . ' found where Operation_97, Operator_116, or Operator_117 expected, dying' )
  187             . "\n";
  188     }
  189     return $cpp_source_group;
  190 }
  191 
  192 1;    # end of class