view release on metacpan or  search on metacpan

perl5/Pugs-Compiler-Perl6/lib/v6.pm  view on Meta::CPAN

    return [$text, {$class => { use => 'dummy' }}, [$class]]
}

sub pmc_filter {
    my ($class, $module, $line_number, $post_process) = @_;
    return 
        if $module eq '-e';
    $class->SUPER::pmc_filter($module, 0, $post_process);
}

sub pmc_compile {
    my ($class, $source) = @_;

    require Pugs::Compiler::Perl6;

    my $p6 = Pugs::Compiler::Perl6->compile( $source );
    my $perl5 = $p6->{perl5};

    # Don't write when we failed to compile, otherwise it never recompiles!
    die unless defined $perl5 
            && length  $perl5;

    # $perl5 =~ s/do\{(.*)\}/$1/s;
    my ($package, $file) = caller(4);

    # allow 'regex' declarations:
    #     use base 'Pugs::Grammar::Base';  
    #   see: t/rules/from_perl6_rules/capture.t

    $perl5 = 
        ( $package 
            ? "package $package;\n" 
            : "package Main; # no package name\n" ).
        ((!$package or ($package eq 'main')) ? (
            "use Config;\n".
            "use lib split(/\\Q\$Config{path_sep}/, \$ENV{PERL6LIB} || '');\n"
        ) : '').
        "use Scalar::Util;
         use Pugs::Runtime::Perl6;
         use Pugs::Runtime::Perl6Prelude;
         use Pugs::Runtime::Perl5Container;
         use base 'Pugs::Grammar::Base';  
         use strict;
         no strict 'refs';
         no warnings ('void', 'uninitialized');
         \$::_V6_COMPILER_OS      = '$^O';
         \$::_V6_COMPILER_NAME    = 'v6.pm';
         \$::_V6_COMPILER_VERSION = '$v6::VERSION';
         undef \$::_V6_MATCH_;
         my \%_V6_PAD;
         our \%_V6_STATE;
        " .  
        # "Pugs::Runtime::Perl6Prelude->import();\n" .   # XXX - is import() needed?
        $perl5 . "\n" .
        "; 1;\n";

    unless ( $ENV{V6NOTIDY} )
    {
      # Perl::Tidy is used if available
      local $@;   # don't care if there are errors here
      local @ARGV = ();  # "You may not specify any filenames ... - Perl::Tidy.pm
      eval {
        require Perl::Tidy;
        my $perl5_tidy;
        Perl::Tidy::perltidy( 
            source => \$perl5, 
            destination => \$perl5_tidy,
            argv => [
                '--maximum-line-length' => 0,
                '--indent-columns'      => 2,
            ],
        );
        $perl5 = $perl5_tidy;
      }
    }

    return $perl5;
}

if (@ARGV and !caller) {
    # We are the main program here
    my ($compile_only, $code);

    if ($ARGV[0] eq '--compile-only') {
        shift(@ARGV);
        $compile_only++;
    }

    shift(@ARGV) if $ARGV[0] =~ /^--pugs/;
    shift(@ARGV) if $ARGV[0] =~ /^-Bperl5$/i;
    splice(@ARGV, 0, 2) if $ARGV[0] =~ /^-B$/;

    while (@ARGV and $ARGV[0] =~ /^-(\w)(.+)/) {
        use Config;
        if($1 eq 'I') {
            $ENV{PERL6LIB} = ((defined($ENV{PERL6LIB}) && $ENV{PERL6LIB} ne '')
                              ? "$Config{path_sep}$ENV{PERL6LIB}"
                              : "");
            $ENV{PERL6LIB} = "$2$ENV{PERL6LIB}";
        }
        shift @ARGV;
    }

    if (@ARGV and $ARGV[0] =~ s/^-e//) {
        $code = (length($ARGV[0]) ? $ARGV[0] : $ARGV[1]);
    }
    else {
        local $/;
        $code = <>;
    }

    if ($compile_only) {
        print __PACKAGE__->pmc_compile($code);
    }
    else {
        local $@;
        eval __PACKAGE__->pmc_compile($code);
        die $@ if $@;
        exit 0;
    }
}