#!/usr/bin/perl

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

if (!@ARGV || grep /^--help$/, @ARGV) {
    die "Usage: $0 [--run] [--pugs|--haskell|--pir] [ source[.pl] | -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|--ghc)$/) {
    $backend = 'Ghc';
    shift @ARGV;
}
elsif ($ARGV[0] =~ /^(?:-P|--pir|--parrot)$/) {
    $backend = 'PIR';
    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_pkg = $ENV{GHC_PKG} || 'ghc_pkg';
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 'PIR') {
    $out .= '.pir';
}
else {
    $out .= ($^O eq 'MSWin32') ? ".exe" : ".out";
}

unlink "dump.ast";

my ($rh, $wh);
my $pid = open2($rh, $wh, 'pugs', -C => $backend, @ARGV);
my $program = do { local $/; <$rh> };
waitpid($pid, 0);

exit 1 unless length $program;

sub writeFile {
    my ($file, $str) = @_;
    open my $fh, '>', $file or die $!;
    print $fh $str;
    close $fh;
}

if ($backend eq 'PIR') {
    writeFile($out, $program);
    chmod 0755, $out;
}
else {
    writeFile("$base/MainCC.hs", $program);

    #fix_path(@ghc_flags);

    my $rv = system(
        $ghc_exe,
        "-v0", "-O", "-o", $out, "--make", "$base/MainCC.hs"
    );

    my $err = $!;
    unless (($rv == 0) and -e $out) {
        if (`$ghc_pkg describe Pugs` !~ /package-url/) {
            warn << '.';

*** Cannot find the 'Pugs' package -- did you run 'make install'
    or 'make register' for Pugs?

.
        };
        die "*** Error making Pugs executable '$out'.\n";
    };

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

die unless -e $out;

if ($run) {
    if ($backend eq 'PIR' 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;
}

#sub fix_path {
#    my ($fs) = ($Config{sitelib} =~ /([\/\\])/)
#        or die "Can't determine file_sep";
#    return if $fs eq '/';
#    s#/#$fs#g for @_;
#}

1;

=pod

=head1 NAME

pugscc - Pugs Compiler Compiler

=head1 SYNOPSIS

    % pugscc --runpir -e "'Hello, Parrot'.say"
    % pugscc --runpugs -e "'Hello, Pugs'.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 L<pugscc> is found in the src/Compile.hs file, and 
the backends are located within src/Compile/. 

=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 PIR - 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

Audrey Tang E<lt>cpan@audreyt.orgE<gt>.

=head1 COPYRIGHT

Copyright 2005, 2006 by Audrey Tang E<lt>cpan@audreyt.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