The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use Cwd;
use Config;
use FindBin;
use File::Copy;
use File::Basename;
use File::Glob 'bsd_glob';

if (!@ARGV || grep /^--help$/, @ARGV) {
    die "Usage: $0 [--run] [--pugs|--haskell|--parrot] [ source[.p6] | -e oneliner ]\n";
}

my $run;

if ($ARGV[0] =~ /^(?:(-)r|(--)run)(.*)$/) {
    $run = 1;
    if ($3) {
        no warnings;
        $ARGV[0] = "$1$2$3";
    }
    else {
        shift @ARGV;
    }
}


my $backend = 'Pugs';
if ($ARGV[0] =~ /^(?:-H|--haskell)$/) {
    $backend = 'Haskell';
    shift @ARGV;
}
elsif ($ARGV[0] =~ /^(?:-P|--parrot)$/) {
    $backend = 'Parrot';
    shift @ARGV;
}
elsif ($ARGV[0] =~ /^--pugs$/) {
    $backend = 'Pugs';
    shift @ARGV;
}

print "*** Using the '$backend' backend.\n" if !$run;

my $ghc_exe = $ENV{GHC} || 'ghc';
my $ghc_version = ghc_version();
my $base = cwd();

$ENV{PATH} = join $Config{path_sep}, ($base, $ENV{PATH});

my $out = 'a';
if (@ARGV and -e $ARGV[0]) {
    $out = basename($ARGV[0]);
    $out =~ s{\..*}{};
}

if ($backend eq 'Parrot') {
    $out .= ".imc";
}
else {
    $out .= ($^O eq 'MSWin32') ? ".exe" : ".out";
}

unlink "dump.ast";
system("pugs", "-C$backend" => @ARGV);
exit 1 unless -e "dump.ast";

if ($backend eq 'Parrot') {
    rename "dump.ast" => $out;
    chmod 0755, $out;
}
else {
    rename "dump.ast" => "$base/MainCC.hs";

    my $archlib = `pugs -V:archlib`;
    $archlib =~ /archlib:\s*(.+)/ or die "Cannot find archlib";
    my $core = "$1/CORE/pugs";

    # XXX - Maybe enable -threaded based on config?
    # XXX - This chunk should be read off Pugs config anyway.
    my @ghc_flags = (
        "-L$base", "-L$core", "-L$core/pcre", "-L$core/syck",
        "-I$base", "-I$core", "-I$core/pcre", "-I$core/syck",
        "-i$base", "-i$core", "-i$core/pcre", "-i$core/syck",
        qw(-static -Wall -fno-warn-unused-imports -fno-warn-unused-binds -fno-warn-missing-signatures -fno-warn-name-shadowing),
    );

    if ($ENV{PUGS_EMBED} and $ENV{PUGS_EMBED} =~ /perl5/i) {
        push @ghc_flags, ("-I$Config{archlib}/CORE", "-L$Config{archlib}/CORE", "-i$Config{archlib}/CORE", "-lperl");
    }

    push @ghc_flags, "$core/pcre/pcre.o";
    push @ghc_flags, bsd_glob("$core/syck/*.o");
    push @ghc_flags, "$core/UnicodeC.o";

    my $rv = system(
        $ghc_exe,
        "-v0", "-o", $out, "--make", "-main-is", "MainCC.mainCC",
        @ghc_flags, "$base/MainCC.hs"
    );

    my $err = $!;
    (($rv == 0) and -e $out) or die $err;

    unlink "$base/MainCC.hs";
    unlink "$base/MainCC.hi";
    unlink "$base/MainCC.o";
}

die unless -e $out;

if ($run) {
    if ($backend eq 'Parrot' and !-x '/usr/bin/env') {
        system("parrot" => $out);
    }
    else {
        system {$out} $out;
    }
}
else {
    print "*** Generated output: $out\n";
}

sub ghc_version {
    my $ghcver = `$ghc_exe --version`;
    ($ghcver =~ /Glasgow.*\bversion\s*(\S+)/s) or die << '.';
*** Cannot find a runnable 'ghc' from path.
*** Please install GHC from http://haskell.org/ghc/.
.
    return $1;
}

1;

=pod

=head1 NAME

pugscc - Pugs Compiler Compiler

=head1 SYNOPSIS

    % pugscc --runpugs -e "'Hello, Parrot'.say"
    % pugscc --runparrot -e "'Hello, Parrot'.say"
    % pugscc --runhaskell -e "'Hello, Haskell'.say"

=head1 DESCRIPTION
               
The 'pugscc' script allows you to create an exectuable image from a
Perl6 script, much like 'perlcc' does for Perl5. 'pugscc' is 
currently in the very early stages (proof-of-concept), and all 
interested hackers are welcome to come join in the fun.

=head1 BACKENDS

'pugscc' is currently in a very early stage, but will eventually 
support a number of different backends. Currently the default (and
only fully working) backend is the 'Pugs' backend which will create
an executable with an embedded pugs interpreter. Experimental 
support also currently exists for a 'Haskell' and 'Parrot' backend, 
with plans for a 'Ponie' and 'Perl5' backend as well (yes, this 
means you can run perl5 code with Pugs too).

=head1 HOW CAN YOU HELP

The main engine for 'pugscc' is found in the src/Compile.hs file, and 
the backends are located within src/Compile/. 

** Autrijus can you write something here? **

=head1 DEPENDENCIES

Here is a list of the various dependencies for each backend, and 
links to where they can be downloaded. 

=over 4

=item Pugs - requires Pugs ;-)

=item Parrot - requires Parrot

L<http://search.cpan.org/~ltoetsch/parrot/>
L<http://www.parrotcode.org/>

=item Haskell - GHC (which is needed for Pugs)

=item Perl5 - requires perl5

L<http://www.perl.org>

=item Ponie - requires Ponie 

L<http://opensource.fotango.com/software/ponie/downloads>
L<http://search.cpan.org/~abergman/ponie/>
L<http://www.poniecode.org/>

=back

=head1 AUTHORS

Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>.

=head1 COPYRIGHT

Copyright 2005 by Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>.

This code is free software; you can redistribute it and/or modify it under
the terms of either:

    a) the GNU General Public License, version 2, or
    b) the Artistic License, version 2.0beta5.

For the full license text, please see the F<GPL-2> and F<Artistic-2> files
under the F<LICENSE> directory in the Pugs distribution.

=cut