view release on metacpan or  search on metacpan

lib/Perlito5/Java/Runtime.pm  view on Meta::CPAN

use v5;

package Perlito5::Java::Runtime;
use strict;

use Perlito5::Java::CORE;
use Perlito5::Java::Crypt;
use Perlito5::Java::JavaCompiler;
use Perlito5::Runtime::Formline;
use Perlito5::Runtime::Sprintf;

sub perl5_to_java {
    my ($source, $namespace, $want, $scope_java) = @_;

    # say "source: [" . $source . "]";

    local $_;
    local ${^GLOBAL_PHASE};
    local @Perlito5::BASE_SCOPE = ($scope_java);  # ->[0];
    local @Perlito5::SCOPE_STMT;
    local $Perlito5::CLOSURE_SCOPE = 0;
    local $Perlito5::PKG_NAME = $namespace;
    local @Perlito5::UNITCHECK_BLOCK;
    local @Perlito5::Java::Java_constants;
    local %Perlito5::Java::Java_constant_seen;

    # warn "in eval enter\n";
    # warn "External scope ", Perlito5::Dumper::Dumper($scope_java);
    # warn "BASE_SCOPE ", Perlito5::Dumper::Dumper($Perlito5::BASE_SCOPE);
    # warn "SCOPE_STMT ", Perlito5::Dumper::Dumper(\@Perlito5::SCOPE_STMT);

    my $match = Perlito5::Grammar::exp_stmts( $source, 0 );

    if ( !$match || $match->{to} < length($source) ) {
        die "Syntax error in eval near pos ", $match->{to};
    }

    # TODO - process type annotations like:
    #   package Java::Object { import => 'java.lang.Object' }
    #
    while ( @Perlito::ANNOTATION ) {
        my $ann = shift(@Perlito::ANNOTATION);
        my $str = Perlito5::AST::CompUnit::process_java_import_statement(@$ann);
        # warn "ANNOTATION: [[[\n$str\n]]]\n";
    }

    my $ast = 
        Perlito5::AST::Call->new(
            method => "postcircumfix:<( )>",
            arguments => [],
            invocant => Perlito5::AST::Sub->new(
                block => Perlito5::AST::Block->new(
                            stmts => $match->{capture},
                         ),
            ),
        );

    # use lexicals from BEGIN scratchpad
    $ast = $ast->emit_begin_scratchpad();

    # warn "perl_to_java: ", Perlito5::Dumper::Dumper( $ast );
    my $java_code = $ast->emit_java(2, $want);

    # say "java-source: [" . $java_code . "]";

    # warn "in perl_to_java: ", Perlito5::Dumper::Dumper( \@Perlito5::Java::Java_constants );

    my $java_classes = Perlito5::Java::get_java_class_info() // {};
    my $className = "PlEval" . $Perlito5::ID++;
    my $constants = "";
    $constants .= 
            "import org.perlito.Perlito5.*;\n"
          . "import java.util.regex.Pattern;\n"
          # . join("",
          #       # import the Java classes
          #       # that were declared with
          #       #
          #       #   package My::Java { import => "org.My.Java", ... }
          #       #
          #       map {
          #                   my $class = $java_classes->{$_};
          #                   $class->{import} ? "import $class->{import};\n" : ()
          #           }
          #           sort keys %$java_classes
          #   )
          . "public class " . $className . " {\n";
    for my $s ( @Perlito5::Java::Java_constants ) {
        # say "s: [[$s]] ", ref($s), "\n";
        $constants .= "    " . $s . ";\n";
    }
    $constants .= 
            "    public " . $className . "() {\n"
          . "    }\n";

    Perlito5::set_global_phase("UNITCHECK");
    $_->() while $_ = shift @Perlito5::UNITCHECK_BLOCK;

    # warn "in eval BASE_SCOPE exit: ", Perlito5::Dumper::Dumper($Perlito5::BASE_SCOPE);

    return ($className, $java_code, $constants);
}

sub eval_ast {
    my ($ast) = @_;
    my $want = 0;

    # TODO - process type annotations like:
    #   package Java::Object { import => 'java.lang.Object' }
    #
    while ( @Perlito::ANNOTATION ) {
        my $ann = shift(@Perlito::ANNOTATION);
        my $str = Perlito5::AST::CompUnit::process_java_import_statement(@$ann);
        # warn "ANNOTATION: [[[\n$str\n]]]\n";
    }

    # warn "AST:\n" . Perlito5::Dumper::Dumper($ast);

    # use lexicals from BEGIN scratchpad
    $ast = $ast->emit_begin_scratchpad();
    # warn "eval_ast: ", Perlito5::Dumper::Dumper( $ast );

    my $java_code = $ast->emit_java(2, $want);
    # say STDERR "java-source: [" . $java_code . "]";
    Perlito5::set_global_phase("UNITCHECK");
    $_->() while $_ = shift @Perlito5::UNITCHECK_BLOCK;
    # warn "in eval BASE_SCOPE exit: ", Perlito5::Dumper::Dumper($Perlito5::BASE_SCOPE);

    my $java_classes = Perlito5::Java::get_java_class_info() // {};
    my $className = "PlEval" . $Perlito5::ID++;
    my $constants = "";
    $constants .= 
            "import org.perlito.Perlito5.*;\n"
          . "import java.util.regex.Pattern;\n"
          # . join("",
          #       # import the Java classes
          #       # that were declared with
          #       #
          #       #   package My::Java { import => "org.My.Java", ... }
          #       #
          #       map {
          #                   my $class = $java_classes->{$_};
          #                   $class->{import} ? "import $class->{import};\n" : ()
          #           }
          #           sort keys %$java_classes
          #   )
          . "public class " . $className . " {\n";
    for my $s ( @Perlito5::Java::Java_constants ) {
        # say "s: [[$s]] ", ref($s), "\n";
        $constants .= "    " . $s . ";\n";
    }
    $constants .= 
            "    public " . $className . "() {\n"
          . "    }\n";

    # warn "constants [[\n$constants ]]\n";

    @_ = ($className, $java_code, $constants);
    return Java::inline('PlJavaCompiler.eval_java_string(List__)');
}

sub emit_java_extends {
    my ($class, $java_classes) = @_;
    # extends the imported Java classes
    # that were declared with
    #
    #   package My::X { extends => "My::Object" }
    #

    # 'extends' => 'My::Object',
    # 'extends_java_type' => 'Object',
    # 'java_native_to_perl' => 'pMyX',
    # 'java_type' => 'MyX',
    # 'perl_package' => 'My::X',
    # 'perl_to_java' => 'to_MyX',
    # 'Java::inline' => " // ... Java code ... \n",
    # 'methods' => [
    #     instance_meth => {
    #         decl => [ "public" ],
    #         return => "Int",
    #         args => [ "Int" ],     # this/$self is added to the Perl method arguments
    #         code => "MyClass::instance_meth",
    #     },
    #     class_meth => {
    #         decl => [ "public", "static" ],
    #         return => "Int",