#!/usr/bin/perl
use strict;
use warnings;
use 5.10.1;
use Nana::Translator::Perl;
use Nana::Parser;
use Getopt::Long::Descriptive;
use Data::Dumper;
use Nana::Translator::Perl::Runtime;

my ($opt, $usage) = describe_options(
    'nana %o <some-arg>',
    [],
    [ 'Dperl', "Dump perl code"   ],
    [ 'Dtree|Dt',   "Dump AST" ],
    [ 'eval|e=s',   "Eval expression" ],
    [ 'I=s@',        "Library path" ],
    [ 'compile-only|c',   "Compile only" ],
    [ 'help|h',       "print usage message and exit" ],
    [ 'version|v',    'print version'],
);
if ($opt->help) {
    print $usage;
    exit 0;
}
if ($opt->version) {
    print "Nana $Nana::Parser::VERSION\n";
    exit 0;
}


Nana::Translator::Perl::Runtime->add_libpath($opt->i || []);

my $parser = Nana::Parser->new;
my $compiler = Nana::Translator::Perl->new();
if (defined $opt->eval) {
    my $ast = $parser->parse($opt->eval);
    say(dump_ast($ast)) if $opt->dtree;
    my $perl = $compiler->compile($ast, '<eval>');
    if ($opt->compile_only) {
        say($perl);
        exit(0);
    } else {
        say($perl) if $opt->dperl;
        eval $perl;
        die $@ if $@;
    }
} elsif (@ARGV) {
    my $fname = shift @ARGV;
    open my $fh, '<', $fname
        or die "Cannot open $fname: $!\n";
    my $ast = $parser->parse(do { local $/; <$fh>; }, $fname);
    say(Dumper($ast)) if $opt->dtree;
    my $perl = $compiler->compile($ast, $fname);
    if ($opt->compile_only) {
        print($perl);
        exit(0);
    } else {
        say($perl) if $opt->dperl;
        eval $perl;
        die $@ if $@;
    }
} else {
    if (-t STDIN && -t STDOUT && !$opt->compile_only) {
        while (1) {
            print(">> ");
            last if eof(STDIN);
            my $input = <>;

            my $ast = $parser->parse($input);
            my $perl = $compiler->compile($ast);
            say("PERL: $perl") if $opt->dperl;
            my $ret = eval $perl;
            die $@ if $@;
            local $Data::Dumper::Terse = 1;
            warn Dumper($ret);
        }
    } else {
        my $input = join('', <>);
        my $ast = $parser->parse($input);
        my $perl = $compiler->compile($ast);
        eval $perl;
        die $@ if $@;
    }
}

sub dump_ast {
    my $ast = shift;
    require Nana::Node;
    Nana::Node->import();
    say _dump_ast($ast);
}

sub _dump_ast {
    my $node = shift;
    my $ret = '[';
    $ret .= node_name($node->[0]);
    if ($node->[0] == NODE_STMTS()) {
        for my $n (@{$node->[2]}) {
            $ret .= ',' . _dump_ast($n);
        }
    } elsif ($node->[0] == NODE_MY()) {
        $ret .= '[';
        for my $n (@{$node->[2]}) {
            if (ref $n eq 'ARRAY') {
                $ret .= ',' . _dump_ast($n);
            } else {
                $ret .= ',' . $n;
            }
        }
        $ret .= ']';
    } elsif ($node->[0] == NODE_CALL()) {
        $ret .= ',' . _dump_ast($node->[2]);
        $ret .= '[';
        for my $n (@{$node->[3]}) {
            if (ref $n eq 'ARRAY') {
                $ret .= ',' . _dump_ast($n);
            } else {
                $ret .= ',' . $n;
            }
        }
        $ret .= ']';
    } else {
        my @node = @$node;
        shift @node;
        shift @node;
        for my $n (@node) {
            if (ref $n eq 'ARRAY') {
                $ret .= ',' . _dump_ast($n);
            } else {
                $ret .= ',' . $n;
            }
        }
    }
    return $ret . ']';
}

__END__

=head1 NAME

nana - tora language interpreter

=head1 SYNPOSIS

    nana [-cehI] [long options...] <some-arg>
                        
        --Dperl             Dump perl code
        --Dt --Dtree        Dump AST
        -e --eval           Eval expression
        -I                  Library path
        -c --compile-only   Compile only
        -h --help           print usage message and exit

=head1 DESCRIPTION

Yet another tora language interpreter on Perl5.

=head1 SEE ALSO

L<http://tora-lang.org>