package gooseutil;

our $VERSION = '0.0.0';
use warnings;
use strict;
no strict 'refs';
use Carp;
$Carp::Verbose = 0;

require Exporter;
our @ISA = qw(Exporter);

our @EXPORT = qw(
                    gs_get_archinfo
                    gs_get_opt_from_dictfile
                    gs_set_verbose
                    gs_get_verbose
                    gs_isdebug
                    gs_debug
                    vprintf
                    dprintf
                    read_c
                    read_text
                    write_c
                    write_text
               );

my $Verbose_default = 2;
my $Verbose         = $Verbose_default;
my $Debug           = 0;

# returns architecture dependent parameters
#
sub gs_get_archinfo {
    my ($arch_name) = @_;

    # GRAPE-DR
    #
    my $gdr = {
        name        => 'gdr',
        path        => undef,
        npe         => 32, # number of PEs.
        funcs       => {   # precompiled functions:
                        'rsqrt' => 1,
                        'pow32' => 1,
                       },
    };

    # AMD
    #
    my $amd = {
        name        => 'amd',
    };

    # NVIDIA
    #
    my $nvidia = {
        name        => 'nvidia',
    };

    my %arch_list = (
        gdr    => $gdr,
        amd    => $amd,
        nvidia => $nvidia,
    );
    my $arch_info = $arch_list{$arch_name};

    if (!defined($arch_info)) {
        printf STDERR
          "invalid architecture name: $arch_name.\n" .
          "valid architecuture names are: ";
        for (sort keys %arch_list) {
            printf STDERR "$_ ";
        }
        die "\n";
    }

    return $arch_info;
}

sub vprintf {
    if ($Verbose > $Verbose_default) {
        printf STDERR @_;
    }
}

sub dprintf {
    if ($Debug) {
        printf STDERR @_;
    }
}

#
# read C source file.
# directives other than '#include' are preprocessed by 'cpp -P'.
# '#include' directives are remain unchanged.
#
sub read_c {
    local ($/);
    local (*IN);
    local (*OUT);
    my ($fname) = @_;
    my $intext;
    my $tmpfile = "tmp$$";

    if (! -r $fname) {
        croak "cannot read input file : $fname. abort.\n";
    }
    croak "$!\n" if !open(IN, "$fname");
    $intext = <IN>;
    close IN;

    $intext =~ s/ ^\#include /\#pragma include/gxms;

    open(OUT, "| cpp -P > $tmpfile");
    print OUT $intext;
    close OUT;

    open(IN, "$tmpfile");
    $intext = <IN>;
    close IN;
    unlink $tmpfile;

    $intext =~ s/ ^\#pragma \s+ include /\#include/gxms;

    # concatenate lines ended with a backslash.
    $intext =~ s/ (.*?)\\\n/ $1 /gx;

    return $intext;
}

sub write_c {
    my ($fname, $data) = @_;
    croak "$!\n" if !open(OUT, "| indent -i4 -sob -npcs -nut -br -bli0 > $fname");
#    croak "$!\n" if !open(OUT, "> $fname");
    print OUT $data;
    print OUT "\n"; # seems to be necessary to flush OUT. I don't know why.
    close OUT;
}

sub read_text {
    local ($/);
    local (*IN);
    my ($fname) = @_;
    my $intext;

    croak "$!\n" if !open(IN, "$fname");
    $intext = <IN>;
    close IN;

    return $intext;
}

sub write_text {
    my ($fname, $data) = @_;
    croak "$!\n" if !open(OUT, "> $fname");
    print OUT $data;
    print OUT "\n"; # seems to be necessary to flush OUT. I don't know why.
    close OUT;
}

sub gs_set_verbose {
    my ($val) = @_;

    if (! defined $val) {
        $val = $Verbose_default + 1;
    }

    $Carp::Verbose = $val;
    $Verbose       = $val;
}

sub gs_get_verbose {
    return $Verbose;
}

sub gs_isdebug {
    return $Debug;
}

sub gs_debug {
    my ($val) = @_;

    if (! defined $val) {
        $val = 1;
    }

    $Carp::Verbose = $val;
    $Debug         = $val;
}

sub gs_get_opt_from_dictfile {
    my ($fname) = @_;
    my %opt;

    dprintf("gs_get_opt_from_dictfile\n");

    open(IN, "$fname") or croak "$!\n";
    while (<IN>) {
        my $line = $_;
        $line =~ / (\w+) \s* : /xms or last; # no more key.
        my $key = $1;
        for ($key) {
            / \A \w+ \z /xms and do {
                $line =~ / (\w+) \s* : \s* ([^\s]+) \s* \z /xms or croak "  no value for key '$key' in '$fname'. abort.";
                my $val = $2;
                dprintf("  key:$key  val:$val\n");
                $opt{$key} = $val;
                next;
            };
        }
    }
    close IN;

    return \%opt;
}

1;

__END__
