# PIL2-JSON simple tokenizer, parser, and code emitter
# ../../pugs -CPIL2-JSON -e ' say "hello" ' | ../../pugs pil2_json_emit.pl

use v6-alpha;

# tokenizer

my $tokens =
    m:g:perl5 {(\"(?:\\\\|\\"|.)*?\"|[\:\,\=\{\(\[\}\)\]]|\w+)};

# JSON parser 
# outputs a p6 tree = Hash of Array|Hash|Scalar ...

sub parse (@start, $token, @end, @_ is rw) {
    state %tok = (
        token => sub (@_ is rw) { 
                ~ @_.shift;     # '~' stringifies "Match" object
            },
        hash =>  sub (@_ is rw) {
                my Array $a;
                loop {
                    return $a if @_[0] eq '}';
                    push $a, parse( <<>>, 'pair', <<>>, @_ );
                    return $a if @_[0] ne ',';
                    @_.shift; 
                }
            },
        list =>  sub (@_ is rw) {
                my Array $a;
                loop {
                    return $a if @_[0] eq ']';
                    push $a, parse( <<>>, 'item', <<>>, @_ );
                    return $a if @_[0] ne ',';
                    @_.shift; 
                }
            },
        pair =>  sub (@_ is rw) {
                my $key = parse( <<>>, 'token', << : >>, @_ );
                # say " Key $key";
                my $value = parse( <<>>, 'item', <<>>, @_ );
                [ $key, $value ];
            },
        item =>  sub (@_ is rw) {
                if @_[0] eq '{' { 
                    return parse( << { >>, 'hash', << } >>, @_ ) 
                };
                if @_[0] eq '[' { 
                    return parse( << [ >>, 'list', << ] >>, @_ ) 
                };
                parse( <<>>, 'token', <<>>, @_ );
            },
    );
    # say " parse: @start[] <$token> @end[]";
    for @start { @_.shift eq $_ or die "Expected $_" }; 
    # say " Tail @_[]";
    my $ret = %tok{$token}( @_ );
    for @end   { @_.shift eq $_ or die "Expected $_" }; 
    $ret;
}

#my @pil2 = =<>;
#my $pil2 = @pil2.join('');

# slurp stdin - xinming++ 
my $pil2 = ** $*IN.slurp;

my @b = $pil2 ~~ $tokens;
# say "Tokens: ", @b.join('><');
my $ast = parse( << { >>, 'hash', << } >>, @b );
# say $ast.perl;

sub print_tree ( $tree ) {
    state $depth = 0;
    $depth++;

    if $tree.WHAT eq 'Array' {

        return if $tree[0] eq '"pPos"';  # ignore position info

        for $tree.values {
            print_tree( $_ );
        }
        say '  ' x ( $depth - 1 ), '-';
    }
    else {
        say '  ' x $depth, "< $tree >";
    }

    $depth--;
}

sub traverse_stmts ( $tree ) {
    if $tree.WHAT eq 'Array' {
        #say $tree.perl;
        if $tree[0] eq '"PApp"' {   
            state $depth = 0;
            $depth++;
            my $tab = '  ' x $depth;

            say "$tab < App start >";
            my %app = $tree[1];  # keys: "pArgs" "pCxt" "pFun" "pInv"
            #say %app.keys;
            say "$tab     Function:  %app<"pFun">";
            say "$tab     Arguments: %app<"pArgs">";
            say "$tab     Context:   %app<"pCxt">";
            say "$tab     Invocant:  %app<"pInv">";
            # print_tree( $tree[1] )
            traverse_stmts( $tree[1] );
            say "$tab < App end >";

            $depth--;
        }
        else {
            traverse_stmts( $_ ) for $tree
        }
    }
}

traverse_stmts( $ast );

# TODO - process BEGIN, END, ...