#! /usr/bin/perl use v5; package Perlito5; use feature 'say'; use Perlito5; use Perlito5::Compiler; use Perlito5::CompileTime::Emitter; use Perlito5::CompileTime::Dumper; use Perlito5::Grammar::Regex6; use Perlito5::Emitter::Token; use Perlito5::Dumper; use Perlito5::JSON; use Perlito5::Javascript2::Emitter; use Perlito5::Javascript2::Runtime; use Perlito5::Javascript2::Array; use Perlito5::Javascript2::CORE; use Perlito5::Javascript2::IO; use Perlito5::Javascript2::Sprintf; use Perlito5::Javascript3::Emitter; use Perlito5::Javascript3::Runtime; use Perlito5::Javascript3::CORE; use Perlito5::Javascript3::IO; use Perlito5::Javascript3::Sprintf; use Perlito5::Perl5::Emitter; use Perlito5::Perl5::PrettyPrinter; use Perlito5::Perl5::Runtime; use Perlito5::Perl6::Emitter; use Perlito5::Perl6::PrettyPrinter; use Perlito5::XS::Emitter; # experimental use Perlito5::Java::Emitter; # experimental use Perlito5::Java::Runtime; ## use Perlito5::Python::Emitter; ## use Perlito5::Ruby::Emitter; use strict; my $_V5_COMPILER_NAME = 'Perlito5'; my $_V5_COMPILER_VERSION = $Perlito5::VERSION; my $source = ''; my $backend = $^O; my $execute = 1; my $verbose = 0; my $expand_use = 1; my $boilerplate = 1; my $bootstrapping = 0; my $wrapper_begin = ''; my $wrapper_end = ''; my $wrapper_priority = 0; my @Use; if ($verbose) { warn "// Perlito5 compiler"; warn "// ARGV: @ARGV"; } my $help_message = " perlito5 [switches] [programfile] switches: -e program one line of program (omit programfile) -h --help -Idirectory specify \@INC/include directory (several -I's allowed) -[mM][-]module execute \"use/no module...\" before executing program -n assume \"while (<>) { ... }\" loop around program -p assume loop like -n but print line also, like sed -V --version -v --verbose -Ctarget target backend: js, perl5, perl6, xs, java -Cast-perl5 emits a dump of the abstract syntax tree as a Perl dump -Cast-json emits a dump of the abstract syntax tree in JSON format --expand_use --noexpand_use expand 'use' statements at compile time --boilerplate --noboilerplate emits or not boilerplate code --bootstrapping set this when compiling the compiler, otherwise the new subroutine definitions will overwrite the current compiler "; my $copyright_message = <<"EOT"; This is Perlito5 $_V5_COMPILER_VERSION, an implementation of the Perl language. The Perl language is Copyright 1987-2012, Larry Wall The Perlito5 implementation is Copyright 2011, 2012 by Flavio Soibelmann Glock and others. Perl may be copied only under the terms of either the Artistic License or the GNU General Public License, which may be found in the Perl 5 source kit. Complete documentation for Perl, including FAQ lists, should be found on this system using "man perl" or "perldoc perl". If you have access to the Internet, point your browser at http://www.perl.org/, the Perl Home Page. EOT sub chomp_switch { # split switches like "-pie" into "-p -i -e" my $s = substr($ARGV[0], 2); if ($s) { $ARGV[0] = "-$s"; } else { shift @ARGV; } } push @Use, "no warnings"; push @Use, "no strict"; ARG_LOOP: while (substr($ARGV[0], 0, 1) eq '-' && substr($ARGV[0], 0, 2) ne '-e' ) { if ($ARGV[0] eq '--verbose') { $verbose = 1; shift @ARGV; } elsif ($ARGV[0] eq '-I') { shift @ARGV; my $lib = shift @ARGV; unshift @INC, $lib; } elsif (substr($ARGV[0], 0, 2) eq '-I') { my $lib = substr($ARGV[0], 2); unshift @INC, $lib; shift @ARGV; } elsif (substr($ARGV[0], 0, 2) eq '-C') { $backend = substr($ARGV[0], 2); $execute = 0; shift @ARGV; } elsif ($ARGV[0] eq '-MO=Deparse') { # this emulates perl -MO=Deparse option $backend = 'perl5'; $execute = 0; $expand_use = 0; shift @ARGV; } elsif (uc(substr($ARGV[0], 0, 2)) eq '-M') { my $s = $ARGV[0]; my $import = ""; if (substr($s, 1, 1) eq "m") { $import = "()"; } $s = substr($s, 2); my $use = "use"; if (substr($s, 0, 1) eq "-") { $use = "no"; $s = substr($s, 1); } if (index($s, "=") > -1) { ($s, $import) = split("=", $s); $import = "split(/,/,q{$import})"; } push @Use, "$use $s $import"; shift @ARGV; } elsif (substr($ARGV[0], 0, 2) eq '-w') { push @Use, "use warnings"; chomp_switch(); } elsif (substr($ARGV[0], 0, 2) eq '-W') { push @Use, "use warnings"; chomp_switch(); } elsif (substr($ARGV[0], 0, 2) eq '-X') { push @Use, "no warnings"; chomp_switch(); } elsif (substr($ARGV[0], 0, 2) eq '-n') { if ($wrapper_priority < 1) { $wrapper_begin = ' LINE: while (<>) { '; $wrapper_end = ' } '; $wrapper_priority = 1; } chomp_switch(); } elsif (substr($ARGV[0], 0, 2) eq '-p') { if ($wrapper_priority < 2) { $wrapper_begin = ' LINE: while (<>) { '; $wrapper_end = ' } continue { ' . ' print or die "-p destination: $!\n"; ' . ' } '; $wrapper_priority = 2; } chomp_switch(); } elsif (($ARGV[0] eq '-V') || ($ARGV[0] eq '--version')) { $backend = ''; say $_V5_COMPILER_NAME, " ", $_V5_COMPILER_VERSION; shift @ARGV; } elsif ($ARGV[0] eq '-v') { $backend = ''; say $copyright_message; shift @ARGV; } elsif ($ARGV[0] eq '-h' || $ARGV[0] eq '--help' || !@ARGV) { $backend = ''; say $_V5_COMPILER_NAME, " ", $_V5_COMPILER_VERSION, $help_message; shift @ARGV; } elsif ($ARGV[0] eq '--expand_use') { $expand_use = 1; shift @ARGV; } elsif ($ARGV[0] eq '--noexpand_use') { $expand_use = 0; shift @ARGV; } elsif ($ARGV[0] eq '--boilerplate') { $boilerplate = 1; shift @ARGV; } elsif ($ARGV[0] eq '--noboilerplate') { $boilerplate = 0; shift @ARGV; } elsif ($ARGV[0] eq '--bootstrapping') { $bootstrapping = 1; shift @ARGV; } elsif ($ARGV[0] eq '-') { shift @ARGV; last ARG_LOOP; } else { die "Unrecognized switch: $ARGV[0] (-h will show valid options).\n"; } } if (!$expand_use) { $Perlito5::EMIT_USE = 1; } if ($backend) { local $Perlito5::FILE_NAME = $ARGV[0]; local $Perlito5::LINE_NUMBER = 1; if ($ARGV[0] eq '-e') { shift @ARGV; if ($verbose) { warn "// source from command line: ", $ARGV[0]; } $source = shift @ARGV; } else { if ($verbose) { warn "// source from file: ", $ARGV[0]; } my $source_filename = shift @ARGV; if ($source_filename eq '') { local $/ = undef; $source = <STDIN>; } else { open FILE, '<:encoding(UTF-8)', $source_filename or die "Cannot read $source_filename: $!\n"; local $/ = undef; $source = <FILE>; close FILE; } } if ($verbose) { warn "// backend: ", $backend; warn "now parsing"; } $Perlito5::PKG_NAME = 'main'; $Perlito5::PROTO = {}; Perlito5::set_global_phase("BEGIN"); $source = "\n# line 1\n" . $source; if ($wrapper_begin) { $source = " $wrapper_begin; $source; $wrapper_end "; } # TODO - reset information about the current compilation process, # this should happen before the eval-string below is *compiled*. # our $BASE_SCOPE = Perlito5::Grammar::Scope->new_base_scope(); # our $SCOPE = $BASE_SCOPE; # information about the current block being compiled if ( $execute ) { $Perlito5::EXPAND_USE = 1; local $@; my $init = join("; ", @Use); eval qq{ Perlito5::set_global_phase("CHECK"); \$_->() for \@Perlito5::CHECK_BLOCK; package main; $init; Perlito5::set_global_phase("INIT"); \$_->() for \@Perlito5::INIT_BLOCK; Perlito5::set_global_phase("RUN"); $source; \$@ = undef }; my $error = $@; warn $error if $error; Perlito5::set_global_phase("END"); $_->() for @Perlito5::END_BLOCK; if ( $error ) { exit(255); } } else { eval { # call the "ahead of time" compiler # since we are generating code that will run from scratch, # we need to start with an empty %INC so that all modules are "used" %INC = (); # partially disable "use" $Perlito5::EXPAND_USE = 0 if $bootstrapping; # start with no-strict no strict; my $m; my $ok; eval { $m = Perlito5::Grammar::exp_stmts($source, 0); $ok = 1; }; if ( !$ok || $m->{to} < length($source) ) { my $error = $@ || ( $m->{to} < length($source) && "Syntax Error near " . $m->{to} ) || "Unknown error"; warn $error; exit(255); } else { my $comp_units; if ($ENV{PERLITO5DEV}) { # "new BEGIN" $comp_units = Perlito5::Match::flat($m); } else { # "old BEGIN" if ($expand_use) { my $ok; eval { $comp_units = Perlito5::Grammar::Use::add_comp_unit(Perlito5::Match::flat($m)); $ok = 1; }; if ( !$ok ) { my $error = $@ || "Unknown error loading a module"; warn $error; exit(255); } } else { $comp_units = Perlito5::Match::flat($m); } } $comp_units = [ Perlito5::AST::CompUnit->new( name => 'main', body => $comp_units, ), ]; { local ${^GLOBAL_PHASE}; Perlito5::set_global_phase("CHECK"); $_->() for @Perlito5::CHECK_BLOCK; } if ($backend eq 'perl5') { say "# Do not edit this file - Generated by ", $_V5_COMPILER_NAME, " ", $_V5_COMPILER_VERSION; if ( $expand_use ) { print Perlito5::Perl5::Runtime->emit_perl5(); } else { $Perlito5::EMIT_USE = 1; } my @data = Perlito5::AST::CompUnit::emit_perl5_program( $comp_units ); # print Perlito5::Dumper::ast_dumper( \@data ); my $out = []; Perlito5::Perl5::PrettyPrinter::pretty_print( \@data, 0, $out ); print join( '', @$out ), ";1\n"; } elsif ($backend eq 'perl6') { if ($boilerplate) { say "# Do not edit this file - Generated by ", $_V5_COMPILER_NAME, " ", $_V5_COMPILER_VERSION; say "use v6;"; } if (!$boilerplate) { # remove 'package main' if ( ref($comp_units) eq 'ARRAY' && (@$comp_units == 1) && ref($comp_units->[0]) eq 'Perlito5::AST::CompUnit' ) { $comp_units = $comp_units->[0]{body}; } } my @data = Perlito5::AST::CompUnit::emit_perl6_program( $comp_units ); # print Perlito5::Dumper::ast_dumper( \@data ); my $out = []; Perlito5::Perl6::PrettyPrinter::pretty_print( \@data, 0, $out ); print join( '', @$out ); print "\n" if $boilerplate; } elsif ($backend eq 'js') { say "// Do not edit this file - Generated by ", $_V5_COMPILER_NAME, " ", $_V5_COMPILER_VERSION; print Perlito5::AST::CompUnit::emit_javascript2_program( $comp_units, expand_use => $expand_use ); } elsif ($backend eq 'js3') { say "// Do not edit this file - Generated by ", $_V5_COMPILER_NAME, " ", $_V5_COMPILER_VERSION; print Perlito5::AST::CompUnit::emit_javascript3_program( $comp_units, expand_use => $expand_use ); } elsif ($backend eq 'xs') { say "/* Do not edit this file - Generated by ", $_V5_COMPILER_NAME, " ", $_V5_COMPILER_VERSION, " */"; print Perlito5::AST::CompUnit::emit_xs_program( $comp_units ); } elsif ($backend eq 'java') { say "// Do not edit this file - Generated by ", $_V5_COMPILER_NAME, " ", $_V5_COMPILER_VERSION; print Perlito5::AST::CompUnit::emit_java_program( $comp_units, expand_use => $expand_use ); } elsif ($backend eq 'ast-perl5') { say Perlito5::Dumper::ast_dumper( $comp_units ); } elsif ($backend eq 'ast-json') { say Perlito5::JSON::ast_dumper( $comp_units ); } elsif ($backend eq 'ast-pretty') { eval 'use Data::Printer {colored=>1,class=>{expand=>"all",show_methods=>"none"}};p($comp_units);1'; print $@; } elsif ($backend eq '_comp') { say Perlito5::Dumper::ast_dumper( $Perlito5::SCOPE ); } elsif ($backend eq '_globals') { # say Perlito5::CompileTime::Dumper::emit_globals_scope($Perlito5::SCOPE); say Perlito5::CompileTime::Dumper::emit_globals($Perlito5::GLOBAL); } elsif ($backend eq '_compile_time') { say Perlito5::Dumper::ast_dumper( Perlito5::AST::CompUnit::emit_compile_time_program( $comp_units ) ); } else { die "don't know what to do with backend '$backend'"; } } $@ = undef; } } if ( $@ ) { my $error = $@; warn $error; exit(255); } } =pod =head1 NAME perlito5 - a Perl5 compiler =head1 SYNOPSIS perlito5 -Isrc5/lib -Cjs program.pl =head1 DESCRIPTION This program reads Perl5 source code and generates native code. The compiler options are available with the command: perlito5 -h =head1 AUTHORS Flavio Soibelmann Glock <fglock@gmail.com>. =head1 SEE ALSO L<http://fglock.github.io/Perlito> =head1 COPYRIGHT Copyright 2011, 2012 by Flavio Soibelmann Glock and others. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L<http://dev.perl.org/licenses/artistic.html> =cut