view release on metacpan or  search on metacpan

inc/Inline/CPP/Parser/RecDescent.pm  view on Meta::CPAN

# long and short aren't recognized as modifiers because they break when used
# as regular types. Another Parse::RecDescent problem is greedy matching; I
# need tmodifier to "give back" long or short in cases where keeping them would
# cause the modifier rule to fail. One side-effect is 'long long' can never
# be parsed correctly here.
modifier: tmod
        | smod { ++$thisparser->{data}{smod}{$item[1]}; ''}
    | nmod { '' }
tmod: 'unsigned' # | 'long' | 'short'
smod: 'const' | 'static'
nmod: 'extern' | 'virtual' | 'mutable' | 'volatile' | 'inline'

scope: 'public' | 'private' | 'protected'

class: 'class' { $thisparser->{data}{defaultscope} = 'private'; $item[1] }
     | 'struct' { $thisparser->{data}{defaultscope} = 'public'; $item[1] }

star: '*' | '&'

code_block: /$Inline::CPP::Parser::RecDescent::code_block/

# Consume expressions
expr: <leftop: subexpr OP subexpr> {
    my $o = join '', @{$item[1]};
#   print "expr: $o\n";
    $o;
}
subexpr: /$Inline::CPP::Parser::RecDescent::funccall/ # Matches a macro, too
       | /$Inline::CPP::Parser::RecDescent::string/
       | /$Inline::CPP::Parser::RecDescent::number/
       | UOP subexpr
OP: '+' | '-' | '*' | '/' | '^' | '&' | '|' | '%' | '||' | '&&'
UOP: '~' | '!' | '-' | '*' | '&'

TYPE: IDENTIFIER

all: /.*/

END
}

#============================================================================
# Generate typemap code for the classes and structs we bind to. This allows
# functions declared after a class to return or accept class objects as
# parameters.
#============================================================================
$TYPEMAP_KIND = 'O_Inline_CPP_Class';

sub typemap {
  my ($parser, $typename) = @_;

#    print "Inline::CPP::Parser::RecDescent::typemap(): typename=$typename\n";

  my ($TYPEMAP, $INPUT, $OUTPUT);
  $TYPEMAP = "$typename *\t\t$TYPEMAP_KIND\n";
  $INPUT   = <<"END";
    if (sv_isobject(\$arg) && (SvTYPE(SvRV(\$arg)) == SVt_PVMG)) {
        \$var = (\$type)SvIV((SV*)SvRV( \$arg ));
    }
    else {
        warn ( \\"\${Package}::\$func_name() -- \$var is not a blessed reference\\" );
        XSRETURN_UNDEF;
    }
END
  $OUTPUT = <<"END";
    sv_setref_pv( \$arg, CLASS, (void*)\$var );
END

  my $ctypename = $typename . ' *';
  $parser->{data}{typeconv}{input_expr}{$TYPEMAP_KIND}  ||= $INPUT;
  $parser->{data}{typeconv}{output_expr}{$TYPEMAP_KIND} ||= $OUTPUT;
  $parser->{data}{typeconv}{type_kind}{$ctypename} = $TYPEMAP_KIND;
  $parser->{data}{typeconv}{valid_types}{$ctypename}++;
  $parser->{data}{typeconv}{valid_rtypes}{$ctypename}++;
  return;
}

#============================================================================
# Default action is to strip ellipses from the C++ code. This allows having
# _only_ a '...' in the code, just like XS. It is the default.
#============================================================================
sub strip_ellipsis {
  my ($parser, $args) = @_;
  return if $parser->{ILSM}{PRESERVE_ELLIPSIS};
  for (my $i = 0; $i < @$args; $i++) {
    next unless $args->[$i]{name} eq '...';

    # if it's the first one, just strip it
    if ($i == 0) {
      substr($parser->{ILSM}{code}, $args->[$i]{offset} - 3, 3, '   ');
    }
    else {
      my $prev        = $i - 1;
      my $prev_offset = $args->[$prev]{offset};
      my $length      = $args->[$i]{offset} - $prev_offset;
      substr($parser->{ILSM}{code}, $prev_offset, $length) =~ s/\S/ /g;
    }
  }
  return;
}

my $hack = sub { # Appease -w using Inline::Files
    print Parse::RecDescent::IN '';
    print Parse::RecDescent::IN '';
    print Parse::RecDescent::TRACE_FILE '';
    print Parse::RecDescent::TRACE_FILE '';
};

1;

=head1 Inline::CPP::Parser::RecDescent

All functions are internal.  No documentation necessary.

=cut