"Fossies" - the Fresh Open Source Software Archive

Member "RPerl-5.002000/lib/RPerl/Operation/Expression/Operator/NamedUnary/Exists.pm" (29 Nov 2019, 15975 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 "Exists.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/exists.html
    3 #     SUPPORTED:  exists EXPR
    4 
    5 # [[[ HEADER ]]]
    6 package RPerl::Operation::Expression::Operator::NamedUnary::Exists;
    7 use strict;
    8 use warnings;
    9 use RPerl::AfterSubclass;
   10 our $VERSION = 0.004_000;
   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                  = 'exists';
   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  = 'exists';
   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::Exists->ast_to_rperl__generate(), received $self = ' . "\n" . RPerl::Parser::rperl_ast__dump($self) . "\n" );
   38 #    RPerl::diag( 'in Operator::NamedUnary::Exists->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                 . $operator_named->{children}->[0]
   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                 . $operator_named->{children}->[0]
   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 
   68 sub ast_to_cpp__generate__CPPOPS_PERLTYPES {
   69     { my string_hashref::method $RETURN_TYPE };
   70     ( my object $self, my string_hashref $modes) = @ARG;
   71     my string_hashref $cpp_source_group = { CPP => q{// <<< RP::O::E::O::NU::E __DUMMY_SOURCE_CODE CPPOPS_PERLTYPES >>>} . "\n" };
   72 
   73     #...
   74     return $cpp_source_group;
   75 }
   76 
   77 
   78 sub ast_to_cpp__generate__CPPOPS_CPPTYPES {
   79     { my string_hashref::method $RETURN_TYPE };
   80     ( my object $self, my object $operator_named, my string_hashref $modes) = @ARG;
   81 
   82     my string_hashref $cpp_source_group = { CPP => q{} };
   83 
   84 #    RPerl::diag( 'in Operator::NamedUnary::Exists->ast_to_cpp__generate__CPPOPS_CPPTYPES(), received $self = ' . "\n" . RPerl::Parser::rperl_ast__dump($self) . "\n" );
   85 #    RPerl::diag( 'in Operator::NamedUnary::Exists->ast_to_cpp__generate__CPPOPS_CPPTYPES(), received $operator_named = ' . "\n" . RPerl::Parser::rperl_ast__dump($operator_named) . "\n" );
   86 
   87     my string $operator_named_class = ref $operator_named;
   88     if ( $operator_named_class eq 'Operation_97' ) {    # Operation -> OP10_NAMED_UNARY_SCOLON
   89         die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASCP016, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Named operator '
   90                 . $operator_named->{children}->[0]
   91                 . ' requires exactly one argument, dying' )
   92             . "\n";
   93     }
   94     elsif ( $operator_named_class eq 'Operator_116' ) {    # Operator -> OP10_NAMED_UNARY SubExpression
   95 #        RPerl::diag( 'in Operator::NamedUnary::Exists->ast_to_cpp__generate__CPPOPS_CPPTYPES(), have $operator_named->{children}->[1] = ' . "\n" . RPerl::Parser::rperl_ast__dump($operator_named->{children}->[1]) . "\n" );
   96 
   97         $cpp_source_group->{CPP} .= NAME_CPPOPS_CPPTYPES() . q{(};
   98 
   99         # check for Variable_198 object, part of hashref name
  100         if ((defined $operator_named->{children}->[1]) and
  101 
  102             (exists  $operator_named->{children}->[1]->{children}) and
  103             (defined $operator_named->{children}->[1]->{children}) and
  104             (defined $operator_named->{children}->[1]->{children}->[0]) and
  105 
  106             (exists  $operator_named->{children}->[1]->{children}->[0]->{children}) and
  107             (defined $operator_named->{children}->[1]->{children}->[0]->{children}) and
  108             (defined $operator_named->{children}->[1]->{children}->[0]->{children}->[0])
  109         ) {
  110             # Variable_198 ISA RPerl::Operation::Expression::SubExpression::Variable
  111             # Variable -> VariableSymbolOrSelf STAR-50
  112             # Variable -> VariableSymbolOrSelf VariableRetrieval*
  113             my object $variable_symbol_or_self = $operator_named->{children}->[1]->{children}->[0]->{children}->[0];
  114             my string $variable_symbol_or_self_class = ref $variable_symbol_or_self;
  115             
  116             # check for VariableSymbolOrSelf_253 object, part of hashref name; directly generate if valid
  117             if ( $variable_symbol_or_self_class eq 'VariableSymbolOrSelf_253' ) {
  118                 if ((exists  $variable_symbol_or_self->{children}) and
  119                     (defined $variable_symbol_or_self->{children}) and
  120                     (defined $variable_symbol_or_self->{children}->[0])
  121                 ) {
  122                     # VariableSymbolOrSelf_253 ISA RPerl::NonGenerator
  123                     # VariableSymbolOrSelf -> VARIABLE_SYMBOL
  124                     my string $symbol_or_self = $variable_symbol_or_self->{children}->[0];
  125 
  126 #                    RPerl::diag( 'in Exists->ast_to_cpp__generate__CPPOPS_CPPTYPES(), have pre-modification $symbol_or_self = ' . $symbol_or_self . "\n" );
  127 
  128                     substr $symbol_or_self, 0, 1, q{}; # remove leading $ sigil
  129 
  130                     $cpp_source_group->{CPP} .= $symbol_or_self . ', ';
  131                 }
  132                 else {
  133                     die RPerl::Parser::rperl_rule__replace(
  134                         'ERROR ECOGEASCP000UG, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Unrecognized grammar rules found where VARIABLE_SYMBOL expected, dying' ) . "\n";
  135                 }
  136             }
  137             # VariableSymbolOrSelf_254 ISA RPerl::NonGenerator
  138             # VariableSymbolOrSelf -> SELF
  139             elsif ( $variable_symbol_or_self_class eq 'VariableSymbolOrSelf_254' ) {
  140                 die RPerl::Parser::rperl_rule__replace(
  141                     'ERROR ECOGEASCP000OO, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Grammar rule '
  142                         . $variable_symbol_or_self_class . ' found where VariableSymbolOrSelf_253 expected, can not treat $self object like a hash, dying' ) . "\n";
  143             }
  144             else {
  145                 die RPerl::Parser::rperl_rule__replace(
  146                     'ERROR ECOGEASCP000, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Grammar rule '
  147                         . $variable_symbol_or_self_class . ' found where VariableSymbolOrSelf_253 expected, dying' ) . "\n";
  148             }
  149         }
  150         else {
  151             die RPerl::Parser::rperl_rule__replace(
  152                 'ERROR ECOGEASCP000UG, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Unrecognized grammar rules found where Variable_198 expected, dying' ) . "\n";
  153         }
  154 
  155         # check for VariableRetrieval_200 and Variable_198 objects, part of hash key lookup; generate if valid
  156         if (
  157             (defined $operator_named->{children}->[1]) and
  158 
  159             (exists  $operator_named->{children}->[1]->{children}) and
  160             (defined $operator_named->{children}->[1]->{children}) and
  161             (defined $operator_named->{children}->[1]->{children}->[0]) and
  162 
  163             (exists  $operator_named->{children}->[1]->{children}->[0]->{children}) and
  164             (defined $operator_named->{children}->[1]->{children}->[0]->{children}) and
  165             (defined $operator_named->{children}->[1]->{children}->[0]->{children}->[1]) and
  166 
  167             (exists  $operator_named->{children}->[1]->{children}->[0]->{children}->[1]->{children}) and
  168             (defined $operator_named->{children}->[1]->{children}->[0]->{children}->[1]->{children}) and
  169             (defined $operator_named->{children}->[1]->{children}->[0]->{children}->[1]->{children}->[0])
  170         ) { 
  171             my object $variable_retrieval = $operator_named->{children}->[1]->{children}->[0]->{children}->[1]->{children}->[0];
  172             my string $variable_retrieval_class = ref $variable_retrieval;
  173 
  174             # VariableRetrieval_200 ISA RPerl::Operation::Expression::SubExpression::Variable::Retrieval
  175             # VariableRetrieval -> OP02_HASH_THINARROW SubExpression '}'
  176             if ( $variable_retrieval_class eq 'VariableRetrieval_200' ) {
  177 #                RPerl::diag( 'in Operator::NamedUnary::Exists->ast_to_cpp__generate__CPPOPS_CPPTYPES(), have $variable_retrieval = ' . "\n" . RPerl::Parser::rperl_ast__dump($variable_retrieval) . "\n" );
  178 
  179 #$VAR1 = bless( {
  180 #    'children' => [
  181 #        '->{',
  182 #        bless( {
  183 #            'children' => [
  184 #                bless( {
  185 #                    'children' => [
  186 #                        bless( {
  187 #                            'children' => [
  188 #                                '$key_not_valid'
  189 #                            ],
  190 #                            'line_number' => 27
  191 #                        }, 'VariableSymbolOrSelf_253 ISA RPerl::NonGenerator' ),
  192 #                        bless( {
  193 #                            'children' => []
  194 #                        }, '_STAR_LIST' )
  195 #                    ],
  196 #                    'line_number' => 27
  197 #                }, 'Variable_198 ISA RPerl::Operation::Expression::SubExpression::Variable' )
  198 #            ],
  199 #            'line_number' => 27
  200 #        }, 'SubExpression_158 ISA RPerl::Operation::Expression::SubExpression::Variable' ),
  201 #        '}'
  202 #    ],
  203 #    'line_number' => 27
  204 #}, 'VariableRetrieval_200 ISA RPerl::Operation::Expression::SubExpression::Variable::Retrieval' );
  205 
  206                 if (
  207                     (exists  $variable_retrieval->{children}) and
  208                     (defined $variable_retrieval->{children}) and
  209                     (defined $variable_retrieval->{children}->[1]) and
  210 
  211                     (exists  $variable_retrieval->{children}->[1]->{children}) and
  212                     (defined $variable_retrieval->{children}->[1]->{children}) and
  213                     (defined $variable_retrieval->{children}->[1]->{children}->[0])
  214                 ) {
  215                     my object $key = $variable_retrieval->{children}->[1]->{children}->[0];
  216                     my string $key_class = ref $key;
  217 
  218                     if ( $key_class eq 'Variable_198' ) {  # Variable -> VariableSymbolOrSelf VariableRetrieval*
  219                         my string_hashref $cpp_source_subgroup = $key->ast_to_cpp__generate__CPPOPS_CPPTYPES( $modes, $self );
  220                         RPerl::Generator::source_group_append( $cpp_source_group, $cpp_source_subgroup );
  221                     }
  222                     else {
  223                         die RPerl::Parser::rperl_rule__replace(
  224                             'ERROR ECOGEASCP000, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Grammar rule '
  225                                 . $key_class . ' found where Variable_198 expected, dying' ) . "\n";
  226                     }
  227                 }
  228                 else {
  229                     die RPerl::Parser::rperl_rule__replace(
  230                         'ERROR ECOGEASCP000UG, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Unrecognized grammar rules found where Variable_198 expected, dying' ) . "\n";
  231                 }
  232             }
  233             # VariableRetrieval_201 ISA RPerl::Operation::Expression::SubExpression::Variable::Retrieval
  234             # VariableRetrieval -> OP02_HASH_THINARROW WORD '}'
  235             elsif ( $variable_retrieval_class eq 'VariableRetrieval_201' ) {
  236 #                RPerl::diag( 'in Operator::NamedUnary::Exists->ast_to_cpp__generate__CPPOPS_CPPTYPES(), have $variable_retrieval = ' . "\n" . RPerl::Parser::rperl_ast__dump($variable_retrieval) . "\n" );
  237 
  238 #$VAR1 = bless( {
  239 #    'children' => [
  240 #        '->{',
  241 #        'key_0',
  242 #        '}'
  243 #    ],
  244 #    'line_number' => 24
  245 #}, 'VariableRetrieval_201 ISA RPerl::Operation::Expression::SubExpression::Variable::Retrieval' );
  246 
  247                 if (
  248                     (exists  $variable_retrieval->{children}) and
  249                     (defined $variable_retrieval->{children}) and
  250                     (defined $variable_retrieval->{children}->[1])
  251                 ) {
  252                     my string $key = $variable_retrieval->{children}->[1];
  253 
  254                     if ( $key eq q{} ) { 
  255                         die RPerl::Parser::rperl_rule__replace(
  256                             'ERROR ECOGEASCP860, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Empty string provided as hash key, dying' ) . "\n";
  257                     }
  258                     # wrap bare-word keys in double quotes and cast to const string
  259                     $cpp_source_group->{CPP} .= q{((const string) "} . $key . q{")};
  260                 }
  261                 else {
  262                     die RPerl::Parser::rperl_rule__replace(
  263                         'ERROR ECOGEASCP000UG, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Unrecognized grammar rules found where Variable_198 expected, dying' ) . "\n";
  264                 }
  265             }
  266             else {
  267                 die RPerl::Parser::rperl_rule__replace(
  268                     'ERROR ECOGEASCP000, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Grammar rule '
  269                         . $variable_retrieval_class . ' found where VariableRetrieval_200 expected, dying' ) . "\n";
  270             }
  271         }   
  272         else {
  273             die RPerl::Parser::rperl_rule__replace(
  274                 'ERROR ECOGEASCP000UG, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Unrecognized grammar rules found where VariableRetrieval_200 and Variable_198 expected, dying' ) . "\n";
  275         }
  276 
  277         $cpp_source_group->{CPP} .= q{)};
  278     }
  279     elsif ( $operator_named_class eq 'Operator_117' ) {    # Operator -> OP10_NAMED_UNARY
  280         die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASCP016, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Named operator '
  281                 . $operator_named->{children}->[0]
  282                 . ' requires exactly one argument, dying' )
  283             . "\n";
  284     }
  285     else {
  286         die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASCP000, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Grammar rule '
  287                 . ($operator_named_class)
  288                 . ' found where Operation_97, Operator_116, or Operator_117 expected, dying' )
  289             . "\n";
  290     }
  291 
  292 #    RPerl::diag( 'in Exists->ast_to_cpp__generate__CPPOPS_CPPTYPES(), about to return $cpp_source_group->{CPP} = ' . "\n" . $cpp_source_group->{CPP} . "\n" );
  293 
  294     return $cpp_source_group;
  295 }
  296 
  297 1;    # end of class